diff options
Diffstat (limited to 'lib')
240 files changed, 9652 insertions, 6606 deletions
diff --git a/lib/Makefile b/lib/Makefile index 98d746925f..7e52d6e32e 100644 --- a/lib/Makefile +++ b/lib/Makefile @@ -33,20 +33,6 @@ ifeq ($(findstring vxworks,$(TARGET)),vxworks) cosFileTransfer cosEventDomain endif else - ifeq ($(findstring ose,$(TARGET)),ose) - ERTS_SUB_DIRECTORIES = stdlib sasl kernel compiler erl_interface - OTHER_SUB_DIRECTORIES = \ - snmp otp_mibs appmon tools -# OTHER_SUB_DIRECTORIES = \ -# appmon os_mon tools runtime_tools - ifdef BUILD_ALL - OTHER_SUB_DIRECTORIES += mnesia \ - inets pman tv observer -# OTHER_SUB_DIRECTORIES += mnesia ic asn1 debugger \ -# inets orber pman tv observer cosTransactions cosEvent \ -# cosTime cosNotification cosProperty cosFileTransfer cosEventDomain - endif - else # # unix and win32 # -------------- @@ -59,10 +45,11 @@ else snmp otp_mibs appmon erl_interface asn1 jinterface gs wx inets ic \ mnesia crypto orber os_mon parsetools syntax_tools pman \ public_key ssl toolbar tv observer debugger reltool odbc \ - runtime_tools diameter \ + diameter \ cosTransactions cosEvent cosTime cosNotification cosProperty \ cosFileTransfer cosEventDomain et megaco webtool \ - xmerl edoc eunit ssh inviso typer docbuilder erl_docgen common_test percept + xmerl edoc eunit ssh inviso typer docbuilder erl_docgen \ + common_test percept dialyzer # dialyzer OTHER_SUB_DIRECTORIES += hipe else # BUILD_ALL on unix @@ -70,15 +57,15 @@ else snmp otp_mibs appmon erl_interface asn1 jinterface wx debugger reltool gs inets \ ic mnesia crypto orber os_mon parsetools syntax_tools \ pman public_key ssl toolbar tv observer odbc \ - runtime_tools diameter \ + diameter \ cosTransactions cosEvent cosTime cosNotification \ cosProperty cosFileTransfer cosEventDomain et megaco webtool \ - xmerl edoc eunit ssh inviso typer docbuilder erl_docgen common_test percept + xmerl edoc eunit ssh inviso typer docbuilder erl_docgen \ + common_test percept dialyzer # dialyzer OTHER_SUB_DIRECTORIES += hipe $(TSP_APP) endif endif - endif endif ifdef BOOTSTRAP diff --git a/lib/asn1/c_src/Makefile b/lib/asn1/c_src/Makefile index 9e9cb18524..f7213b9651 100644 --- a/lib/asn1/c_src/Makefile +++ b/lib/asn1/c_src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2010. All Rights Reserved. +# Copyright Ericsson AB 2002-2011. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -51,33 +51,26 @@ EI_LIBDIR = $(ERL_TOP)/lib/erl_interface/obj$(TYPEMARKER)/$(TARGET) # ---------------------------------------------------- # FLAGS # ---------------------------------------------------- -EI_INCLUDES = -I$(ERL_TOP)/lib/erl_interface/include CFLAGS = $(DED_INCLUDES) $(EI_INCLUDES) $(DED_CFLAGS) LDFLAGS += $(DED_LDFLAGS) -LD_INCL_EI = -L$(EI_LIBDIR) - # ---------------------------------------------------- # Target Specs # ---------------------------------------------------- -C_FILES = asn1_erl_driver.c +NIF_OBJ_FILES = $(OBJDIR)/asn1_erl_nif.o ifeq ($(TARGET),win32) -LD_EI = -lei_md -SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_drv.dll -OBJ_FILES = $(OBJDIR)/asn1_erl_drv.o +NIF_SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_nif.dll CLIB_FLAGS = LN=cp else -LD_EI = -lei -OBJ_FILES = $(OBJDIR)/asn1_erl_drv.o ifeq ($(findstring vxworks,$(TARGET)),vxworks) -SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_drv.eld +NIF_SHARED_OBJ_FILE = $(LIBDIR)/asn1_erl_nif.eld CLIB_FLAGS = else -SHARED_OBJ_FILES = $(LIBDIR)/asn1_erl_drv.so +NIF_SHARED_OBJ_FILE = $(LIBDIR)/asn1_erl_nif.so CLIB_FLAGS = -lc endif LN= ln -s @@ -87,7 +80,9 @@ endif # Targets # ---------------------------------------------------- -opt: $(OBJDIR) $(LIBDIR) $(SHARED_OBJ_FILES) +_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) + +opt: $(NIF_SHARED_OBJ_FILE) debug: opt @@ -103,20 +98,12 @@ docs: # ---------------------------------------------------- -$(OBJ_FILES): $(C_FILES) - $(CC) -c $(CFLAGS) -o $(OBJ_FILES) $(C_FILES) - -$(SHARED_OBJ_FILES): $(OBJ_FILES) - $(LD) $(LDFLAGS) $(LD_INCL_EI) -o $(SHARED_OBJ_FILES) $(OBJ_FILES) $(LD_EI) $(CLIB_FLAGS) $(LIBS) - -$(LIBDIR): - -mkdir -p $(LIBDIR) - -$(OBJDIR): - -mkdir -p $(OBJDIR) +$(OBJDIR)/%.o: %.c + $(CC) -c $(CFLAGS) -O3 -o $@ $< +$(NIF_SHARED_OBJ_FILE): $(NIF_OBJ_FILES) + $(LD) $(LDFLAGS) -o $(NIF_SHARED_OBJ_FILE) $(NIF_OBJ_FILES) $(CLIB_FLAGS) $(LIBS) - # ---------------------------------------------------- # Release Target # ---------------------------------------------------- @@ -124,9 +111,9 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/priv/lib - $(INSTALL_PROGRAM) $(SHARED_OBJ_FILES) $(RELSYSDIR)/priv/lib + $(INSTALL_PROGRAM) $(NIF_SHARED_OBJ_FILE) $(RELSYSDIR)/priv/lib $(INSTALL_DIR) $(RELSYSDIR)/c_src - $(INSTALL_DATA) $(C_FILES) $(RELSYSDIR)/c_src + $(INSTALL_DATA) *.c $(RELSYSDIR)/c_src release_docs_spec: diff --git a/lib/asn1/c_src/asn1_erl_driver.c b/lib/asn1/c_src/asn1_erl_driver.c deleted file mode 100644 index 18d4157941..0000000000 --- a/lib/asn1/c_src/asn1_erl_driver.c +++ /dev/null @@ -1,1677 +0,0 @@ -/* - * %CopyrightBegin% - * - * Copyright Ericsson AB 2002-2011. All Rights Reserved. - * - * The contents of this file are subject to the Erlang Public License, - * Version 1.1, (the "License"); you may not use this file except in - * compliance with the License. You should have received a copy of the - * Erlang Public License along with this software. If not, it can be - * retrieved online at http://www.erlang.org/. - * - * Software distributed under the License is distributed on an "AS IS" - * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - * the License for the specific language governing rights and limitations - * under the License. - * - * %CopyrightEnd% - * - */ -#include <stdlib.h> -#include <stdio.h> -#include <string.h> -#include "erl_driver.h" -#include "ei.h" - - -/* #define ASN1_DEBUG 1 */ - -#define ASN1_OK 0 -#define ASN1_ERROR -1 -#define ASN1_COMPL_ERROR 1 -#define ASN1_MEMORY_ERROR 0 -#define ASN1_DECODE_ERROR 2 -#define ASN1_TAG_ERROR -3 -#define ASN1_LEN_ERROR -4 -#define ASN1_INDEF_LEN_ERROR -5 -#define ASN1_VALUE_ERROR -6 - - -#define ASN1_CLASS 0xc0 -#define ASN1_FORM 0x20 -#define ASN1_CLASSFORM (ASN1_CLASS | ASN1_FORM) -#define ASN1_TAG 0x1f -#define ASN1_LONG_TAG 0x7f - -#define ASN1_INDEFINITE_LENGTH 0x80 -#define ASN1_SHORT_DEFINITE_LENGTH 0 - -#define ASN1_PRIMITIVE 0 -#define ASN1_CONSTRUCTED 0x20 - -#define ASN1_COMPLETE 1 -#define ASN1_BER_TLV_DECODE 2 -#define ASN1_BER_TLV_PARTIAL_DECODE 3 - -#define ASN1_NOVALUE 0 - -#define ASN1_SKIPPED 0 -#define ASN1_OPTIONAL 1 -#define ASN1_CHOOSEN 2 - - -#define CEIL(X,Y) ((X-1) / Y + 1) - -#define INVMASK(X,M) (X & (M ^ 0xff)) -#define MASK(X,M) (X & M) - -typedef struct { - ErlDrvPort port; - int buffer_size; -} asn1_data; - -/* int min_alloc_bytes; */ - - -static ErlDrvData asn1_drv_start(ErlDrvPort, char *); - -static void asn1_drv_stop(ErlDrvData); - -int asn1_drv_control(ErlDrvData, unsigned int, char *, int, char **, int); - -int complete(ErlDrvBinary **,unsigned char *,unsigned char *, int); - -int insert_octets(int, unsigned char **, unsigned char **, int *); - -int insert_octets_except_unused(int, unsigned char **, unsigned char **, - int *, int); - -int insert_octets_as_bits_exact_len(int, int, unsigned char **, - unsigned char **, int *); - -int insert_octets_as_bits(int, unsigned char **, unsigned char **,int *); - -int pad_bits(int, unsigned char **, int *); - -int insert_least_sign_bits(int, unsigned char, unsigned char **, int *); - -int insert_most_sign_bits(int, unsigned char, unsigned char **, int *); - -int insert_bits_as_bits(int, int, unsigned char **, unsigned char **, int *); - -int insert_octets_unaligned(int, unsigned char **, unsigned char **, int); - -int realloc_decode_buf(ErlDrvBinary **,int); - -int realloc_memory(ErlDrvBinary **,int,unsigned char **,unsigned char **); - -int decode_begin(ErlDrvBinary **,unsigned char *, int, unsigned int *); - -int decode(ErlDrvBinary **,int *,unsigned char *,int *, int); - -int decode_tag(char *,int *,unsigned char *,int,int *); - -int decode_value(int *,unsigned char *,int *,ErlDrvBinary **,int ,int); - - -/* declaration of functions used for partial decode of a BER encoded - message */ - -int decode_partial(ErlDrvBinary **,unsigned char *, int); - -int skip_tag(unsigned char *,int *,int); - -int skip_length_and_value(unsigned char *,int *,int); - -int get_tag(unsigned char *,int *,int); - -int get_length(unsigned char *,int *,int *,int); - -int get_value(char *,unsigned char *,int *,int); - -static ErlDrvEntry asn1_drv_entry = { - NULL, /* init, always NULL for dynamic drivers */ - asn1_drv_start, /* start, called when port is opened */ - asn1_drv_stop, /* stop, called when port is closed */ - NULL, /* output, called when erlang has sent */ - NULL, /* ready_input, called when input descriptor ready */ - NULL, /* ready_output, called when output descriptor ready */ - "asn1_erl_drv", /* char *driver_name, the argument to open_port */ - NULL, /* finish, called when unloaded */ - NULL, /* void * that is not used (BC) */ - asn1_drv_control, /* control, port_control callback */ - NULL, /* timeout, called on timeouts */ - NULL, /* outputv, vector output interface */ - - NULL, /* ready_async */ - NULL, /* flush */ - NULL, /* call */ - NULL, /* event */ - ERL_DRV_EXTENDED_MARKER, - ERL_DRV_EXTENDED_MAJOR_VERSION, - ERL_DRV_EXTENDED_MINOR_VERSION, - ERL_DRV_FLAG_USE_PORT_LOCKING, - NULL, /* handle2 */ - NULL /* process_exit */ -}; - - - -DRIVER_INIT(asn1_erl_drv) /* must match name in driver_entry */ -{ - return &asn1_drv_entry; -} - -static ErlDrvData asn1_drv_start(ErlDrvPort port, char *buff) -{ - /* extern int min_alloc_bytes; */ - char *ptr; - asn1_data* d; - - d = (asn1_data*)driver_alloc(sizeof(asn1_data)); - set_port_control_flags(port, PORT_CONTROL_FLAG_BINARY); - d->port = port; - - if ((ptr = getenv("ASN1_MIN_BUF_SIZE")) == NULL) - d->buffer_size = 1024; - else - d->buffer_size = atoi(ptr); - return (ErlDrvData)d; -} - - -static void asn1_drv_stop(ErlDrvData handle) -{ - driver_free((char*)handle); -} - - - -int asn1_drv_control(ErlDrvData handle, - unsigned int command, - char *buf, - int buf_len, - char **res_buf, - int res_buf_len) -{ - unsigned char *complete_buf; - int complete_len, decode_len; - ErlDrvBinary *drv_binary; - ErlDrvBinary **drv_bin_ptr; - asn1_data* a_data; - int min_alloc_bytes; - unsigned int err_pos = 0; /* in case of error, return last correct position */ - int ret_err; /* return value in case of error in TLV decode, i.e. length of list in res_buf */ - - /* In case previous call to asn1_drv_control resulted in a change of - return value from binary to integer list */ - a_data = (asn1_data *)handle; - min_alloc_bytes = a_data->buffer_size; - set_port_control_flags(a_data->port, PORT_CONTROL_FLAG_BINARY); - - if (command == ASN1_COMPLETE) - { - if (buf_len==0) { - return 0; /* Avoid binary buffer overwrite (OTP-8451) */ - } - /* Do the PER complete encode step */ - if ((drv_binary = driver_alloc_binary(buf_len))==NULL) { - /* error handling */ - set_port_control_flags(a_data->port, 0); - return ASN1_MEMORY_ERROR; - } - complete_buf = (unsigned char*) drv_binary->orig_bytes; - if ((complete_len = complete(&drv_binary,complete_buf,(unsigned char*) buf,buf_len)) == ASN1_ERROR) - { - /* error handling due to failure in complete */ - /* printf("error when running complete\n\r"); */ - driver_free_binary(drv_binary); - set_port_control_flags(a_data->port, 0); - **res_buf = '1'; - return ASN1_COMPL_ERROR; - } - /* printf("complete_len=%dbuf_len=%d,orig_size=%d\n\r",complete_len,buf_len,drv_binary->orig_size); */ - /* now the message is complete packed, return to Erlang */ - /* if (complete_len < buf_len) {*/ - if (complete_len < drv_binary->orig_size) { - ErlDrvBinary *tmp; - if ((tmp=driver_realloc_binary(drv_binary,complete_len)) == NULL){ - /*error handling due to memory allocation failure */ - driver_free_binary(drv_binary); - set_port_control_flags(a_data->port, 0); - return ASN1_MEMORY_ERROR; - }else - drv_binary=tmp; - } - *res_buf = (char *)drv_binary; - return complete_len; - } else if (command == ASN1_BER_TLV_DECODE) { /* control == 2 */ - /* Do the tlv decode, - return the resulting term encoded on the Erlang - external format */ -/* printf("driver: buffer_len = %d, min_alloc_bytes = %d\r\n",buf_len,min_alloc_bytes); */ - if ((drv_binary = driver_alloc_binary((buf_len*5)+min_alloc_bytes))==NULL) { - /* error handling */ - set_port_control_flags(a_data->port, 0); - return ASN1_MEMORY_ERROR; - } - drv_bin_ptr = &drv_binary; - if ((decode_len = decode_begin(drv_bin_ptr,(unsigned char*)buf,buf_len,&err_pos)) <= ASN1_ERROR) - { - /* error handling due to failure in decode */ - char tmp_res_buf[5]; - driver_free_binary(*drv_bin_ptr); - set_port_control_flags(a_data->port, 0); - - if(decode_len==ASN1_ERROR) - tmp_res_buf[0]='1'; - else if(decode_len==ASN1_TAG_ERROR) - tmp_res_buf[0]='2'; - else if(decode_len==ASN1_LEN_ERROR) - tmp_res_buf[0]='3'; - else if(decode_len==ASN1_INDEF_LEN_ERROR) - tmp_res_buf[0]='4'; - else if(decode_len==ASN1_VALUE_ERROR) - tmp_res_buf[0]='5'; -/* printf("err_pos=%d\r\n",err_pos); */ -/* printf("decode_len:%d\r\n",decode_len); */ - ret_err = 1; - while(err_pos>0){ - tmp_res_buf[ret_err] =(char)err_pos;/* c;*/ - err_pos = err_pos >> 8; - ret_err++; - } - strncpy(*res_buf,tmp_res_buf,ret_err); - return ret_err; - } -/* printf("decode_len=%d\r\n",decode_len); */ - if (decode_len < ((buf_len * 5) + min_alloc_bytes)) { - /* not all memory was used => we have to reallocate */ - ErlDrvBinary *tmp; - if ((tmp=driver_realloc_binary(*drv_bin_ptr,decode_len)) == NULL){ - /*error handling due to memory allocation failure */ - driver_free_binary(*drv_bin_ptr); - set_port_control_flags(a_data->port, 0); - return ASN1_MEMORY_ERROR; - }else - *drv_bin_ptr=tmp; - } - *res_buf = (char *)(*drv_bin_ptr); - return decode_len; - } else { /*command == ASN1_BER_TLV_PARTIAL_DECODE */ - if ((drv_binary = driver_alloc_binary(buf_len))==NULL) { - /* error handling */ - set_port_control_flags(a_data->port, 0); - return ASN1_MEMORY_ERROR; - } - drv_bin_ptr = &drv_binary; - if ((decode_len = decode_partial(drv_bin_ptr,(unsigned char*)buf,buf_len)) - <= ASN1_ERROR) { - /* error handling due to failure in decode */ - driver_free_binary(*drv_bin_ptr); - set_port_control_flags(a_data->port, 0); - -/* printf("asn1_drv_control 1: decode_len=%d\r\n",decode_len); */ - - if(decode_len==ASN1_ERROR) - **res_buf = '1'; - return ASN1_DECODE_ERROR; - } - if (decode_len < buf_len) { - /* not all memory was used => we have to reallocate */ - ErlDrvBinary *tmp; -/* printf("asn1_drv_control 2: decode_len=%d\r\n",decode_len); */ - if ((tmp=driver_realloc_binary(*drv_bin_ptr,decode_len)) == NULL){ - /*error handling due to memory allocation failure */ - driver_free_binary(*drv_bin_ptr); - set_port_control_flags(a_data->port, 0); - return ASN1_MEMORY_ERROR; - }else - *drv_bin_ptr=tmp; - } - *res_buf = (char *)(*drv_bin_ptr); - return decode_len; - } -} - - - -/* - * - * This section defines functionality for the complete encode of a - * PER encoded message - * - */ - -int complete(ErlDrvBinary **drv_binary,unsigned char *complete_buf, - unsigned char *in_buf, int in_buf_len) -{ - int counter = in_buf_len; - /* counter keeps track of number of bytes left in the - input buffer */ - - int buf_space = in_buf_len; - /* This is the amount of allocated space left of the complete_buf. It - is possible when padding is applied that more space is needed than - was originally allocated. */ - - int buf_size = in_buf_len; - /* Size of the buffer. May become reallocated and thus other than - in_buf_len */ - - unsigned char *in_ptr, *ptr; - /* in_ptr points at the next byte in in_buf to be moved to - complete_buf. - ptr points into the new completed buffer, complete_buf, at the - position of the next byte that will be set */ - int unused = 8; - /* unused = [1,...,8] indicates how many of the rigthmost bits of - the byte that ptr points at that are unassigned */ - - int no_bits,no_bytes,in_unused,desired_len,ret, saved_mem, needed, pad_bits; - - unsigned char val; - - in_ptr = in_buf; - ptr = complete_buf; - *ptr = 0x00; - while(counter > 0) { - counter--; -/* printf("*in_ptr = %d\n\r",*in_ptr); */ - switch (*in_ptr) { - case 0: - /* just one zero-bit should be added to the buffer */ - if(unused == 1){ - unused = 8; - *++ptr = 0x00; - buf_space--; - } else - unused--; - break; - - case 1: - /* one one-bit should be added to the buffer */ - if(unused == 1){ - *ptr = *ptr | 1; - unused = 8; - *++ptr = 0x00; - buf_space--; - } else { - *ptr = *ptr | (1 << (unused - 1)); - unused--; - } - break; - - case 2: - /* align buffer to end of byte */ - if (unused != 8) { - *++ptr = 0x00; - buf_space--; - unused = 8; - } - break; - - case 10: - /* next byte in in_buf tells how many bits in the second next - byte that will be used */ - /* The leftmost unused bits in the value byte are supposed to be - zero bits */ - no_bits = (int)*(++in_ptr); - val = *(++in_ptr); - counter -= 2; - if ((ret=insert_least_sign_bits(no_bits,val,&ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 20: - /* in this case the next value in_ptr points at holds the number - of following bytes that holds the value that will be inserted - in the completed buffer */ - no_bytes = (int)*(++in_ptr); - counter -= (no_bytes + 1); - if ((counter<0) || - (ret=insert_octets(no_bytes,&in_ptr,&ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 21: - /* in this case the next two bytes in_ptr points at holds the number - of following bytes that holds the value that will be inserted - in the completed buffer */ - no_bytes = (int)*(++in_ptr); - no_bytes = no_bytes << 8; - no_bytes = no_bytes | (int)*(++in_ptr); - counter -= (2 + no_bytes); - if ((counter<0) || - (ret=insert_octets(no_bytes,&in_ptr,&ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 30: - /* If we call the following bytes, in the buffer in_ptr points at, - By1,By2,Rest then Rest is the value that will be transfered to - the completed buffer. By1 tells how many of the rightmost bits in - Rest that should not be used. By2 is the length of Rest in bytes.*/ - in_unused = (int)*(++in_ptr); - no_bytes = (int)*(++in_ptr); - counter -= (2 + no_bytes); -/* printf("%d: case 30: in_unused=%d, no_bytes=%d,counter=%d\n\r",__LINE__,in_unused,no_bytes,counter); */ - ret = -4711; - if ((counter<0) || - (ret=insert_octets_except_unused(no_bytes,&in_ptr,&ptr,&unused,in_unused)) == ASN1_ERROR) - return ASN1_ERROR; -/* printf("%d: ret=%d\n\r",__LINE__, ret); */ - buf_space -= ret; - break; - - case 31: - /* If we call the following bytes, in the buffer in_ptr points at, - By1,By2,By3,Rest then Rest is the value that will be transfered to - the completed buffer. By1 tells how many of the rightmost bits in - Rest that should not be used. By2 and By3 is the length of - Rest in bytes.*/ - in_unused = (int)*(++in_ptr); - no_bytes = (int)*(++in_ptr); - no_bytes = no_bytes << 8; - no_bytes = no_bytes | (int)*(++in_ptr); - counter -= (3 + no_bytes); - if ((counter<0) || - (ret=insert_octets_except_unused(no_bytes,&in_ptr,&ptr,&unused,in_unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 40: - /* This case implies that next byte,By1,(..,By1,By2,Bin,...) - is the desired length of the completed value, maybe needs - padding zero bits or removal of trailing zero bits from Bin. - By2 is the length of Bin and Bin is the value that will be - put into the completed buffer. Each byte in Bin has the value - 1 or 0.*/ - desired_len = (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - - /* This is the algorithm for need of memory reallocation: - Only when padding (cases 40 - 43,45 - 47) more memory may be - used than allocated. Therefore one has to keep track of how - much of the allocated memory that has been saved, i.e. the - difference between the number of parsed bytes of the input buffer - and the number of used bytes of the output buffer. - If saved memory is less than needed for the padding then we - need more memory. */ - saved_mem = buf_space - counter; - pad_bits = desired_len - no_bytes - unused; - needed = (pad_bits > 0) ? CEIL(pad_bits,8) : 0; - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (2 + no_bytes); - if ((counter<0) || - (ret=insert_octets_as_bits_exact_len(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 41: - /* Same as case 40 apart from By2, the length of Bin, which is in - two bytes*/ - desired_len = (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - no_bytes = no_bytes << 8; - no_bytes = no_bytes | (int)*(++in_ptr); - - saved_mem = buf_space - counter; - needed = CEIL((desired_len-unused),8) - no_bytes; - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (3 + no_bytes); - if ((counter<0) || - (ret=insert_octets_as_bits_exact_len(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 42: - /* Same as case 40 apart from By1, the desired length, which is in - two bytes*/ - desired_len = (int)*(++in_ptr); - desired_len = desired_len << 8; - desired_len = desired_len | (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - - saved_mem = buf_space - counter; - needed = CEIL((desired_len-unused),8) - no_bytes; - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (3 + no_bytes); - if ((counter<0) || - (ret=insert_octets_as_bits_exact_len(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 43: - /* Same as case 40 apart from By1 and By2, the desired length and - the length of Bin, which are in two bytes each. */ - desired_len = (int)*(++in_ptr); - desired_len = desired_len << 8; - desired_len = desired_len | (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - no_bytes = no_bytes << 8; - no_bytes = no_bytes | (int)*(++in_ptr); - - saved_mem = buf_space - counter; - needed = CEIL((desired_len-unused),8) - no_bytes; - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (4 + no_bytes); - if ((counter<0) || - (ret=insert_octets_as_bits_exact_len(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 45: - /* This case assumes that the following bytes in the incoming buffer - (called By1,By2,Bin) is By1, which is the number of bits (n) that - will be inserted in the completed buffer. By2 is the number of - bytes in Bin. Each bit in the buffer Bin should be inserted from - the leftmost until the nth.*/ - desired_len = (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - - saved_mem = buf_space - counter; - needed = CEIL((desired_len-unused),8) - no_bytes; -/* printf("buf_space=%d, counter=%d, needed=%d",buf_space,counter,needed); */ - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (2 + no_bytes); -/* printf("calling insert_bits_as_bits: desired_len=%d, no_bytes=%d\n\r",desired_len,no_bytes); */ -/* printf("1in_ptr=%d\n\r",in_ptr); */ - - if((counter<0) || - (ret=insert_bits_as_bits(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; -/* printf("2in_ptr=%d, ptr=%d, complete_buf=%d\n\r",in_ptr,ptr,complete_buf); */ -/* printf("buf_space=%d, ret=%d, counter=%d\n\r",buf_space,ret,counter); */ - buf_space -= ret; - break; - - case 46: - /* Same as case 45 apart from By1, the desired length, which is - in two bytes. */ - desired_len = (int)*(++in_ptr); - desired_len = desired_len << 8; - desired_len = desired_len | (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - - saved_mem = buf_space - counter; - needed = CEIL((desired_len-unused),8) - no_bytes; - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (3 + no_bytes); - if((counter<0) || - (ret=insert_bits_as_bits(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - case 47: - /* Same as case 45 apart from By1 and By2, the desired length - and the length of Bin, which are in two bytes each. */ - desired_len = (int)*(++in_ptr); - desired_len = desired_len << 8; - desired_len = desired_len | (int)*(++in_ptr); - no_bytes=(int)*(++in_ptr); - no_bytes = no_bytes << 8; - no_bytes = no_bytes | (int)*(++in_ptr); - - saved_mem = buf_space - counter; - needed = CEIL((desired_len-unused),8) - no_bytes; - if (saved_mem < needed) { - /* Have to allocate more memory */ - buf_size += needed; - buf_space += needed; - if (realloc_memory(drv_binary,buf_size,&ptr, - &complete_buf) == ASN1_ERROR) - return ASN1_ERROR; - } - - counter -= (4 + no_bytes); - if((counter<0) || - (ret=insert_bits_as_bits(desired_len,no_bytes,&in_ptr, - &ptr,&unused)) == ASN1_ERROR) - return ASN1_ERROR; - buf_space -= ret; - break; - - default: - return ASN1_ERROR; - } - in_ptr++; - } - /* The returned buffer must be at least one byte and - it must be octet aligned */ - if ((unused == 8) && (ptr != complete_buf)) - return (ptr - complete_buf); - else { - ptr++; /* octet align buffer */ - return (ptr - complete_buf); - } -} - - -int realloc_memory(ErlDrvBinary **drv_binary, - int amount, - unsigned char **ptr, - unsigned char **complete_buf) { - - ErlDrvBinary *tmp_bin; - int i; - -/* printf("realloc_momory: amount = %d\n",amount); */ - if ((tmp_bin=driver_realloc_binary(*drv_binary,amount)) == NULL) { - /*error handling due to memory allocation failure */ -/* printf("error when allocating memory\n"); */ - return ASN1_ERROR; - }else { - i = *ptr - *complete_buf; - *drv_binary=tmp_bin; - *complete_buf = (unsigned char*)(*drv_binary)->orig_bytes; - *ptr = *complete_buf + i; - } - return ASN1_OK; -} - - -int insert_most_sign_bits(int no_bits, - unsigned char val, - unsigned char **output_ptr, - int *unused) { - unsigned char *ptr = *output_ptr; - - if (no_bits < *unused){ - *ptr = *ptr | (val >> (8 - *unused)); - *unused -= no_bits; - } else if (no_bits == *unused) { - *ptr = *ptr | (val >> (8 - *unused)); - *unused = 8; - *++ptr = 0x00; - } else { - *ptr = *ptr | (val >> (8 - *unused)); - *++ptr = 0x00; - *ptr = *ptr | (val << *unused); - *unused = 8 - (no_bits - *unused); - } - *output_ptr = ptr; - return ASN1_OK; -} - - -int insert_least_sign_bits(int no_bits, - unsigned char val, - unsigned char **output_ptr, - int *unused) { - unsigned char *ptr = *output_ptr; - int ret = 0; - - if (no_bits < *unused){ - *ptr = *ptr | (val << (*unused - no_bits)); - *unused -= no_bits; - } else if (no_bits == *unused){ - *ptr = *ptr | val; - *unused = 8; - *++ptr = 0x00; - ret++; - } else { - /* first in the begun byte in the completed buffer insert - so many bits that fit, then insert the rest in next byte.*/ - *ptr = *ptr | (val >> (no_bits - *unused)); - *++ptr = 0x00; - ret++; - *ptr = *ptr | (val << (8 - (no_bits - *unused))); - *unused = 8 - (no_bits - *unused); - } - *output_ptr = ptr; - return ret; -} - -/* pad_bits adds no_bits bits in the buffer that output_ptr - points at. - */ -int pad_bits(int no_bits, unsigned char **output_ptr, int *unused) - { - unsigned char *ptr = *output_ptr; - int ret = 0; - - while (no_bits > 0) { - if(*unused == 1){ - *unused = 8; - *++ptr = 0x00; - ret++; - } else - (*unused)--; - no_bits--; - } - *output_ptr = ptr; - return ret; - } - - -/* insert_bits_as_bits removes no_bytes bytes from the buffer that in_ptr - points at and takes the desired_no leftmost bits from those removed - bytes and inserts them in the buffer(output buffer) that ptr points at. - The unused parameter tells how many bits that are not set in the - actual byte in the output buffer. If desired_no is more bits than the - input buffer has in no_bytes bytes, then zero bits is padded.*/ -int insert_bits_as_bits(int desired_no, - int no_bytes, - unsigned char **input_ptr, - unsigned char **output_ptr, - int *unused) -{ - unsigned char *in_ptr = *input_ptr; - unsigned char val; - int no_bits, ret, ret2; - - if (desired_no == (no_bytes * 8)) { - if(insert_octets_unaligned(no_bytes,&in_ptr,output_ptr,*unused) - == ASN1_ERROR) - return ASN1_ERROR; - ret = no_bytes; - } - else if (desired_no < (no_bytes * 8)) { -/* printf("insert_bits_as_bits 1\n\r"); */ - if(insert_octets_unaligned(desired_no/8,&in_ptr,output_ptr,*unused) - == ASN1_ERROR) - return ASN1_ERROR; -/* printf("insert_bits_as_bits 2\n\r"); */ - val = *++in_ptr; -/* printf("val = %d\n\r",(int)val); */ - no_bits = desired_no % 8; -/* printf("no_bits = %d\n\r",no_bits); */ - insert_most_sign_bits(no_bits,val,output_ptr,unused); - ret = CEIL(desired_no,8); - } - else { - if(insert_octets_unaligned(no_bytes,&in_ptr,output_ptr,*unused) - == ASN1_ERROR) - return ASN1_ERROR; - ret2 = pad_bits(desired_no - (no_bytes * 8),output_ptr,unused); -/* printf("ret2 = %d\n\r",ret2); */ - ret = CEIL(desired_no,8); -/* printf("ret = %d\n\r",ret); */ - } -/* printf("*unused = %d\n\r",*unused); */ - *input_ptr = in_ptr; - return ret; -} - - -/* insert_octets_as_bits_exact_len */ -int -insert_octets_as_bits_exact_len(int desired_len, - int in_buff_len, - unsigned char **in_ptr, - unsigned char **ptr, - int *unused) -{ - int ret = 0; - int ret2 = 0; - - if (desired_len == in_buff_len) { - if ((ret = insert_octets_as_bits(in_buff_len,in_ptr,ptr,unused)) == ASN1_ERROR) - return ASN1_ERROR; - } - else if(desired_len > in_buff_len) { - if((ret = insert_octets_as_bits(in_buff_len,in_ptr,ptr,unused)) == ASN1_ERROR) - return ASN1_ERROR; - /* now pad with zero bits */ -/* printf("~npad_bits: called with %d bits padding~n~n~r",desired_len - in_buff_len); */ - if ((ret2=pad_bits(desired_len - in_buff_len,ptr,unused)) == ASN1_ERROR) - return ASN1_ERROR; - } - else {/* desired_len < no_bits */ - if ((ret=insert_octets_as_bits(desired_len,in_ptr,ptr,unused)) == ASN1_ERROR) - return ASN1_ERROR; - /* now remove no_bits - desired_len bytes from in buffer */ - *in_ptr += (in_buff_len - desired_len); - } - return (ret+ret2); -} - - - -/* insert_octets_as_bits takes no_bytes bytes from the buffer that input_ptr - points at and inserts the least significant bit of it in the buffer that - output_ptr points at. Each byte in the input buffer must be 1 or 0 - otherwise the function returns ASN1_ERROR. The output buffer is concatenated - without alignment. - */ -int insert_octets_as_bits(int no_bytes, - unsigned char **input_ptr, - unsigned char **output_ptr, - int *unused) -{ - unsigned char *in_ptr = *input_ptr; - unsigned char *ptr = *output_ptr; - int used_bits = 8 - *unused; - - while (no_bytes > 0) { - switch (*++in_ptr) { - case 0: - if(*unused == 1){ - *unused = 8; - *++ptr = 0x00; - } else - (*unused)--; - break; - case 1: - if(*unused == 1){ - *ptr = *ptr | 1; - *unused = 8; - *++ptr = 0x00; - } else { - *ptr = *ptr | (1 << (*unused - 1)); - (*unused)--; - } - break; - default: - return ASN1_ERROR; - } - no_bytes--; - } - *input_ptr = in_ptr; - *output_ptr = ptr; - return ((used_bits+no_bytes) / 8); /*return number of new bytes - in completed buffer */ -} - -/* insert_octets inserts bytes from the input buffer, *input_ptr, - into the output buffer, *output_ptr. Before the first byte is - inserted the input buffer is aligned. - */ -int insert_octets(int no_bytes, - unsigned char **input_ptr, - unsigned char **output_ptr, - int *unused) -{ - unsigned char *in_ptr = *input_ptr; - unsigned char *ptr = *output_ptr; - int ret = 0; - - if (*unused != 8) {/* must align before octets are added */ - *++ptr = 0x00; - ret++; - *unused = 8; - } - while(no_bytes > 0) { - *ptr = *(++in_ptr); - *++ptr = 0x00; - /* *unused = *unused - 1; */ - no_bytes--; - } - *input_ptr = in_ptr; - *output_ptr = ptr; - return (ret + no_bytes); -} - -/* insert_octets_unaligned inserts bytes from the input buffer, *input_ptr, - into the output buffer, *output_ptr.No alignment is done. - */ -int insert_octets_unaligned(int no_bytes, - unsigned char **input_ptr, - unsigned char **output_ptr, - int unused) -{ - unsigned char *in_ptr = *input_ptr; - unsigned char *ptr = *output_ptr; - int n = no_bytes; - unsigned char val; - - while (n > 0) { - if (unused == 8) { - *ptr = *++in_ptr; - *++ptr = 0x00; - }else { - val = *++in_ptr; - *ptr = *ptr | val >> (8 - unused); - *++ptr = 0x00; - *ptr = val << unused; - } - n--; - } - *input_ptr = in_ptr; - *output_ptr = ptr; - return no_bytes; -} - - -int insert_octets_except_unused(int no_bytes, - unsigned char **input_ptr, - unsigned char **output_ptr, - int *unused, - int in_unused) -{ - unsigned char *in_ptr = *input_ptr; - unsigned char *ptr = *output_ptr; - int val, no_bits; - int ret = 0; - - if (in_unused == 0){ -/* printf("%d: insert_octets_except_unused: if\n\r",__LINE__); */ - if ((ret = insert_octets_unaligned(no_bytes,&in_ptr,&ptr, - *unused)) == ASN1_ERROR) - return ASN1_ERROR; - } - else { -/* printf("%d: insert_octets_except_unused: else\n\r",__LINE__); */ - if ((ret=insert_octets_unaligned(no_bytes - 1,&in_ptr,&ptr,*unused)) != ASN1_ERROR) { - val = (int) *(++in_ptr); - no_bits = 8 - in_unused; - /* no_bits is always less than *unused since the buffer is - octet aligned after insert:octets call, so the following - if clasuse is obsolete I think */ - if(no_bits < *unused){ - *ptr = *ptr | (val >> (8 - *unused)); - *unused = *unused - no_bits; - } else if (no_bits == *unused) { - *ptr = *ptr | (val >> (8 - *unused)); - *++ptr = 0x00; - ret++; - *unused = 8; - } else { - *ptr = *ptr | (val >> (8 - *unused)); - *++ptr = 0x00; - ret++; - *ptr = *ptr | (val << *unused); - *unused = 8 - (no_bits - *unused); - } - } else - return ASN1_ERROR; - } - *input_ptr = in_ptr; - *output_ptr = ptr; -/* printf("%d: insert_octets_except_unused: ret=%d\n\r",__LINE__,ret); */ - return ret; -} - - - -/* - * - * This section defines functionality for the partial decode of a - * BER encoded message - * - */ - -/* - * int decode(ErlDrvBinary **drv_binary,unsigned char *decode_buf, - * unsigned char *in_buf, int in_buf_len) - * drv_binary is a pointer to a pointer to an allocated driver binary. - * in_buf is a pointer into the buffer of incoming bytes. - * in_buf_len is the length of the incoming buffer. - * The function reads the bytes in the incoming buffer and structures - * it in a nested way as Erlang terms. The buffer contains data in the - * order tag - length - value. Tag, length and value has the following - * format: - * A tag is normally one byte but may be of any length, if the tag number - * is greater than 30. +----------+ - * |CL|C|NNNNN| - * +----------+ - * If NNNNN is 31 then will the 7 l.s.b of each of the following tag number - * bytes contain the tag number. Each tag number byte that is not the last one - * has the m.s.b. set to 1. - * The length can be short definite length (sdl), long definite length (ldl) - * or indefinite length (il). - * sdl: +---------+ the L bits is the length - * |0|LLLLLLL| - * +---------+ - * ldl: +---------+ +---------+ +---------+ +-----------+ - * |1|lllllll| |first len| | | |the Nth len| - * +---------+ +---------+ +---------+ ... +-----------+ - * The first byte tells how many len octets will follow, max 127 - * il: +---------+ +----------------------+ +--------+ +--------+ - * |1|0000000| |content octets (Value)| |00000000| |00000000| - * +---------+ +----------------------+ +--------+ +--------+ - * The value octets are preceded by one octet and followed by two - * exactly as above. The value must be some tag-length-value encoding. - * - * The function returns a value in Erlnag term format: - * {{TagNo,Value},Rest} - * TagNo is an integer ((CL bsl 16) + tag number) which limits the tag number - * to 65535. - * Value is a binary if the C bit in tag was unset, otherwise (if tag was - * constructed) Value is a list, List. - * List is like: [{TagNo,Value},{TagNo,Value},...] - * Rest is a binary, i.e. the undecoded part of the buffer. Most often Rest - * is the empty binary. - * If some error occured during the decoding of the in_buf an error is returned. - */ -int decode_begin(ErlDrvBinary **drv_binary,unsigned char *in_buf, int in_buf_len, unsigned int *err_pos) -{ - int maybe_ret; - char *decode_buf = (*drv_binary)->orig_bytes; - int ei_index = 0; - int ib_index = 0; - /* ei_index is the index used by the ei functions to encode an - Erlang term into the buffer decode_buf */ - /* ib_index is the index were to read the next byte from in_buf */ - - -#ifdef ASN1_DEBUG - printf("decode_begin1: ei_index=%d, ib_index=%d\n\r",ei_index,ib_index); -#endif - /* the first byte must be a "version magic" */ - if(ei_encode_version(decode_buf,&ei_index) == ASN1_ERROR) - return ASN1_ERROR; /* 1 byte */ -#ifdef ASN1_DEBUG - printf("decode_begin2: ei_index=%d, ib_index=%d\n\r",ei_index,ib_index); -#endif - if (ei_encode_tuple_header(decode_buf,&ei_index,2) == ASN1_ERROR) - return ASN1_ERROR; /* 2 bytes */ -#ifdef ASN1_DEBUG - printf("decode_begin3: ei_index=%d, ib_index=%d\n\r",ei_index,ib_index); -#endif - if((maybe_ret=decode(drv_binary,&ei_index,in_buf,&ib_index,in_buf_len)) <= ASN1_ERROR) - { - *err_pos = ib_index; -#ifdef ASN1_DEBUG - printf("err_pos=%d,ib_index=%d\r\n",*err_pos,ib_index); -#endif - return maybe_ret; - }; - - decode_buf = (*drv_binary)->orig_bytes; /* maybe a realloc during decode_value */ -#ifdef ASN1_DEBUG - printf("decode_begin4: in_buf_len=%d, ei_index=%d, ib_index=%d\n\r", - in_buf_len,ei_index,ib_index); -#endif - /* "{{TagNo,Value},Rest}" */ - if (ei_encode_binary(decode_buf,&ei_index,&(in_buf[ib_index]),in_buf_len-ib_index) - == ASN1_ERROR) /* at least 5 bytes */ - return ASN1_ERROR; -#ifdef ASN1_DEBUG - printf("decode_begin5: ei_index=%d, ib_index=%d\n\r",ei_index,ib_index); -#endif - return ei_index; -} - -int decode(ErlDrvBinary **drv_binary,int *ei_index,unsigned char *in_buf, - int *ib_index, int in_buf_len) -{ - int maybe_ret; - char *decode_buf = (*drv_binary)->orig_bytes; - int form; -#ifdef ASN1_DEBUG - printf("decode 1\n\r"); -#endif - if (((*drv_binary)->orig_size - *ei_index) < 19) {/* minimum amount of bytes */ - /* allocate more memory */ - if (realloc_decode_buf(drv_binary,(*drv_binary)->orig_size * 2) == - ASN1_ERROR) - return ASN1_ERROR; - decode_buf = (*drv_binary)->orig_bytes; - } -/* printf("decode 2\n\r"); */ - /* "{" */ - if (ei_encode_tuple_header(decode_buf,ei_index,2) == ASN1_ERROR) - return ASN1_ERROR; /* 2 bytes */ -#ifdef ASN1_DEBUG - printf("decode 3:orig_size=%ld, ei_index=%d, ib_index=%d\n\r",(*drv_binary)->orig_size,*ei_index,*ib_index); -#endif - - /*buffer must hold at least two bytes*/ - if ((*ib_index +2) > in_buf_len) - return ASN1_VALUE_ERROR; - /* "{{TagNo," */ - if ((form = decode_tag(decode_buf,ei_index,in_buf,in_buf_len,ib_index)) <= ASN1_ERROR) - return form; /* 5 bytes */ -#ifdef ASN1_DEBUG - printf("i_i=%d,in_buf_len=%d\r\n",*ei_index,in_buf_len); -#endif - if (*ib_index >= in_buf_len){ - return ASN1_TAG_ERROR; - } -#ifdef ASN1_DEBUG - printf("decode 5 ib_index=%d\n\r",*ib_index); -#endif - /* buffer must hold at least one byte (0 as length and nothing as - value) */ - /* "{{TagNo,Value}," */ - if ((maybe_ret=decode_value(ei_index,in_buf,ib_index,drv_binary,form, - in_buf_len)) <= ASN1_ERROR) - return maybe_ret; /* at least 5 bytes */ -#ifdef ASN1_DEBUG - printf("decode 7\n\r"); -#endif - return *ei_index; -} - -/* - * decode_tag decodes the BER encoded tag in in_buf and puts it in the - * decode_buf encoded by the Erlang extern format as an Erlang term. - */ -int decode_tag(char *decode_buf,int *db_index,unsigned char *in_buf, - int in_buf_len, int *ib_index) -{ - int tag_no, tmp_tag, form; - - - /* first get the class of tag and bit shift left 16*/ - tag_no = ((MASK(in_buf[*ib_index],ASN1_CLASS)) << 10); - - form = (MASK(in_buf[*ib_index],ASN1_FORM)); -#ifdef ASN1_DEBUG - printf("decode_tag0:ii=%d, tag_no=%d, form=%d.\r\n", - *ib_index,tag_no,form); -#endif - - /* then get the tag number */ - if((tmp_tag = (int) INVMASK(in_buf[*ib_index],ASN1_CLASSFORM)) < 31) { - ei_encode_ulong(decode_buf,db_index,tag_no+tmp_tag); /* usual case */ - (*ib_index)++; -#ifdef ASN1_DEBUG - printf("decode_tag1:ii=%d.\r\n",*ib_index); -#endif - } - else - { - int n = 0; /* n is used to check that the 64K limit is not - exceeded*/ -#ifdef ASN1_DEBUG - printf("decode_tag1:ii=%d, in_buf_len=%d.\r\n",*ib_index,in_buf_len); -#endif - - /* should check that at least three bytes are left in - in-buffer,at least two tag byte and at least one length byte */ - if ((*ib_index +3) > in_buf_len) - return ASN1_VALUE_ERROR; - (*ib_index)++; -#ifdef ASN1_DEBUG - printf("decode_tag2:ii=%d.\r\n",*ib_index); -#endif - /* The tag is in the following bytes in in_buf as - 1ttttttt 1ttttttt ... 0ttttttt, where the t-bits - is the tag number*/ - /* In practice is the tag size limited to 64K, i.e. 16 bits. If - the tag is greater then 64K return an error */ - while (((tmp_tag = (int)in_buf[*ib_index]) >= 128) && n < 2){ - /* m.s.b. = 1 */ - tag_no = tag_no + (MASK(tmp_tag,ASN1_LONG_TAG) << 7); - (*ib_index)++; -#ifdef ASN1_DEBUG - printf("decode_tag3:ii=%d.\r\n",*ib_index); -#endif - n++; - }; - if ((n==2) && in_buf[*ib_index] > 3) - return ASN1_TAG_ERROR; /* tag number > 64K */ - tag_no = tag_no + in_buf[*ib_index]; - (*ib_index)++; -#ifdef ASN1_DEBUG - printf("decode_tag4:ii=%d.\r\n",*ib_index); -#endif - ei_encode_ulong(decode_buf,db_index,tag_no); - } - return form; -} - - -/* - * decode_value decodes the BER encoded length and value fields in the - * in_buf and puts the value part in the decode_buf as an Erlang term - * encoded by the Erlang extern format - */ -int decode_value(int *ei_index,unsigned char *in_buf, - int *ib_index,ErlDrvBinary **drv_binary,int form, - int in_buf_len) -{ - int maybe_ret; - char *decode_buf = (*drv_binary)->orig_bytes; - unsigned int len = 0; - unsigned int lenoflen = 0; - int indef = 0; - -#ifdef ASN1_DEBUG - printf("decode_value1:ib_index=%d\n\r",*ib_index); -#endif - if (((in_buf[*ib_index]) & 0x80) == ASN1_SHORT_DEFINITE_LENGTH) { - len = in_buf[*ib_index]; - } - else if (in_buf[*ib_index] == ASN1_INDEFINITE_LENGTH) - indef = 1; - else /* long definite length */ { - lenoflen = (in_buf[*ib_index] & 0x7f); /*length of length */ -#ifdef ASN1_DEBUG - printf("decode_value,lenoflen:%d\r\n",lenoflen); -#endif - if (lenoflen > (in_buf_len - (*ib_index+1))) - return ASN1_LEN_ERROR; - len = 0; - while (lenoflen-- ) { - (*ib_index)++; -#ifdef ASN1_DEBUG - printf("decode_value1:*ib_index=%d, byte = %d.\r\n",*ib_index,in_buf[*ib_index]); -#endif - if (!(len < (1 << (sizeof(len)-1)*8))) - return ASN1_LEN_ERROR; /* length does not fit in 32 bits */ - len = (len << 8) + in_buf[*ib_index]; - } - } - if (len > (in_buf_len - (*ib_index + 1))) - return ASN1_VALUE_ERROR; - (*ib_index)++; -#ifdef ASN1_DEBUG - printf("decode_value2:ii=%d.\r\n",*ib_index); -#endif - if (indef == 1) - { /* in this case it is desireably to check that indefinite length - end bytes exist in inbuffer */ - while (!(in_buf[*ib_index]==0 && in_buf[*ib_index + 1]==0)) { -#ifdef ASN1_DEBUG - printf("decode_value while:ib_index=%d in_buf_len=%d\n\r", - *ib_index,in_buf_len); -#endif - if(*ib_index >= in_buf_len) - return ASN1_INDEF_LEN_ERROR; - ei_encode_list_header(decode_buf,ei_index,1); /* 5 bytes */ - if((maybe_ret=decode(drv_binary,ei_index,in_buf, - ib_index,in_buf_len)) <= ASN1_ERROR) - return maybe_ret; - decode_buf = (*drv_binary)->orig_bytes; - } - (*ib_index) += 2; /* skip the indefinite length end bytes */ -#ifdef ASN1_DEBUG - printf("decode_value3:ii=%d.\r\n",*ib_index); -#endif - ei_encode_empty_list(decode_buf,ei_index); /* 1 byte */ - } - else if (form == ASN1_CONSTRUCTED) - { - int end_index = *ib_index + len; - if(end_index > in_buf_len) - return ASN1_LEN_ERROR; - while (*ib_index < end_index) { - -#ifdef ASN1_DEBUG - printf("decode_value3:*ib_index=%d, end_index=%d\n\r",*ib_index,end_index); -#endif - ei_encode_list_header(decode_buf,ei_index,1); /* 5 bytes */ - if((maybe_ret=decode(drv_binary,ei_index,in_buf, - ib_index,in_buf_len))<=ASN1_ERROR) - return maybe_ret; - decode_buf = (*drv_binary)->orig_bytes; - } - ei_encode_empty_list(decode_buf,ei_index); /* 1 byte */ - } - else - { - if (((*drv_binary)->orig_size - *ei_index) < 10+len) { /* 5+len for the binary*/ - if (realloc_decode_buf(drv_binary,(*drv_binary)->orig_size * 2) == - ASN1_ERROR) - return ASN1_ERROR; - decode_buf = (*drv_binary)->orig_bytes; - } - if((*ib_index + len) > in_buf_len) - return ASN1_LEN_ERROR; - ei_encode_binary(decode_buf,ei_index,&in_buf[*ib_index],len); - *ib_index = *ib_index + len; -#ifdef ASN1_DEBUG - printf("decode_value4:ii=%d.\r\n",*ib_index); -#endif - } - return ASN1_OK; -} - -int realloc_decode_buf(ErlDrvBinary **drv_binary,int amount) { - ErlDrvBinary *tmp_bin; - - if ((tmp_bin=driver_realloc_binary(*drv_binary,amount)) == NULL) - return ASN1_ERROR; - *drv_binary = tmp_bin; - return ASN1_OK; -} - - - -/* - * int decode_partial(drv_binary,in_buf,in_buf_len) - */ -/* - * The in_buf contains two parts: first information about which value - * will be decoded, as a sequence of tags and tag codes, then the - * encoded BER value. First of all comes a length field that tells how - * many following bytes contains the sequence of tags. Then starts the - * BER encoded message. The tag sequence length field is a single - * byte. The sequence of tags/tag codes may be one of the codes - * ASN1_SKIPPED, ASN1_CHOOSEN and a tag or ASN1_OPTIONAL and a - * tag. ASN1_SKIPPED means that the following tag is mandatory and is - * skipped. ASN1_CHOOSEN means that the value of this tag shall, if - * this was the last tag in tag sequence, be returned or be searched - * in for the next tag. ASN1_OPTIONAL means that this tag shall be - * skipped but it may be missing. Each tag in the tag sequence - * correspond to a tag in the BER encoded message. If the decode - * arives to a position where there is no matching tag, an error is - * returned (if it wasn't the last tag and it was OPTIONAL). After the - * right value has been detected it is returned in the out_buf. - * - */ -int decode_partial(ErlDrvBinary **drv_binary,unsigned char *in_buf, int in_buf_len) -{ - char *out_buf = (*drv_binary)->orig_bytes; - int tag_index_val = 1; - int msg_index_val; - int *msg_index, *tag_index, tmp_index; - int tag_seq_length; - int wanted_tag, next_tag; - int buf_end_index = in_buf_len; - int ret = 0, length, old_index; - - tag_index = &tag_index_val; - tag_seq_length = in_buf[0]; - msg_index = &msg_index_val; - *msg_index = tag_seq_length + 1; - - -/* printf("decode_partial 1: in_buf_len=%d, tag_index=%d, msg_index=%d\r\n,tag_seq_length=%d\r\n",in_buf_len,*tag_index,*msg_index,tag_seq_length); */ - while(*tag_index < tag_seq_length) { - switch(in_buf[*tag_index]) { - case ASN1_SKIPPED: -/* printf("decode_partial ASN1_SKIPPED: in_buf[*msg_index]=%d\r\n",in_buf[*msg_index]); */ - (*tag_index)++; -/* printf("decode_partial ASN1_SKIPPED 2: *msg_index=%d\r\n",*msg_index); */ - skip_tag(in_buf,msg_index,buf_end_index); -/* printf("decode_partial ASN1_SKIPPED 3: *msg_index=%d\r\n",*msg_index); */ - skip_length_and_value(in_buf,msg_index,buf_end_index); -/* printf("decode_partial ASN1_SKIPPED 4: *msg_index=%d\r\n",*msg_index); */ - break; - case ASN1_OPTIONAL: - (*tag_index)++; -/* printf("decode_partial ASN1_OPTIONAL: in_buf[*tag_index]=%d\r\n",in_buf[*tag_index]); */ - wanted_tag = in_buf[*tag_index]; - (*tag_index)++; - tmp_index = *msg_index; - next_tag = get_tag(in_buf,msg_index,buf_end_index); - if (wanted_tag != next_tag) { - *msg_index = tmp_index; - } else - skip_length_and_value(in_buf,msg_index,buf_end_index); - break; - case ASN1_CHOOSEN: -/* printf("decode_partial ASN1_CHOOSEN: in_buf[*msg_index]=%d, *msg_index=%d\r\n",in_buf[*msg_index],*msg_index); */ - (*tag_index)++; - wanted_tag = in_buf[*tag_index]; - (*tag_index)++; - old_index = *msg_index; -/* printf("decode_partial ASN1_CHOOSEN 2: *msg_index=%d\r\n",*msg_index); */ - next_tag = get_tag(in_buf,msg_index,buf_end_index); -/* printf("decode_partial ASN1_CHOOSEN 3: *msg_index=%d\r\n,wanted_tag=%d, next_tag=%d\r\n",*msg_index,wanted_tag,next_tag); */ - if (wanted_tag != next_tag) - return ASN1_NOVALUE; /* an empty binary will be returned to Erlang */ - if (*tag_index == (tag_seq_length + 1)) { - /* get the value and return*/ - if((ret = get_value(out_buf,in_buf,msg_index,buf_end_index)) <= ASN1_ERROR) - return ASN1_ERROR; - return ret; - } - else { - /* calculate the length of the sub buffer and let *msg_index - be at the value part of this BER encoded type*/ - int indef; - indef = 0; - length = get_length(in_buf,msg_index,&indef,buf_end_index); -/* printf("decode_partial ASN1_CHOOSEN 4: length=%d, *msg_index=%d\r\n",length,*msg_index); */ - if ((length == 0) && (indef == 1)) { - /* indefinite length of value */ - old_index = *msg_index; - length = skip_length_and_value(in_buf,msg_index,buf_end_index); - *msg_index = old_index; - buf_end_index = *msg_index + length - 2; - /* remove two bytes due to indefinete length end zeros */ - } else - buf_end_index = (*msg_index + length); - } - break; - default: - return ASN1_ERROR; - } - } - return ASN1_ERROR; -} - - -/* - * int skip_tag(unsigned char *in_buf,int *index,int buf_len) - * steps past the BER encoded tag in in_buf and updates *index. - * Returns the number of skipped bytes. - */ -int skip_tag(unsigned char *in_buf,int *index,int buf_len) -{ - int start_index = *index; - if ((MASK(in_buf[*index],ASN1_TAG)) == 31){ - do { - (*index)++; - if (*index >= buf_len) - return ASN1_ERROR; - } - while(in_buf[*index] >=128); - } - (*index)++; - return (*index - start_index); -} - - -/* - * int skip_length_and_value(unsigned char *in_buf,int *index,int buf_len) - * steps past the BER encoded length and value in in_buf and updates *index. - * returns the length if the skipped "length value". - * Returns the number of skipped bytes. - */ -int skip_length_and_value(unsigned char *in_buf,int *index,int buf_len) -{ - long len; - int indef = 0, lenoflen; - int start_index = *index; - - if ((MASK(in_buf[*index],0x80)) == ASN1_SHORT_DEFINITE_LENGTH){ - len = in_buf[*index]; - if (len > (buf_len - (*index + 1))) - return ASN1_LEN_ERROR; - } else if (in_buf[*index] == ASN1_INDEFINITE_LENGTH) - indef = 1; - else /* long definite length */ { - lenoflen = (in_buf[*index] & 0x7f); /*length of length */ - len = 0; - while (lenoflen--) { - (*index)++; - len = (len << 8) + in_buf[*index]; - } - if (len > (buf_len - (*index + 1))) - return ASN1_LEN_ERROR; - } - (*index)++; - if (indef == 1) - { - while(!(in_buf[*index]==0 && in_buf[*index + 1]==0)) { - skip_tag(in_buf,index,buf_len); - skip_length_and_value(in_buf,index,buf_len); - } - (*index) += 2; - } - else - (*index) += len; - return (*index - start_index); -} - -/* int get_tag(unsigned char *in_buf,int *index) - * - * assumes next byte/bytes in in_buf is an encoded BER tag. A tag - * number has theoretically no upper limit in size. Here the tag - * number is assumed to be less than 64K. Returns an integer value - * on the format: - * xxxxxxxx xxxxxxcc tttttttt tttttttt - * the x-bits are 0 (insignificant) - * the c-bits are the class of the tag - * the t-bits are the tag number. This implies that the tag number - * is limited to 64K-1 - * - */ -int get_tag(unsigned char *in_buf,int *index,int buf_len) -{ - int tag_no = 0,tmp_tag = 0; - - tag_no = (MASK(in_buf[*index],ASN1_CLASSFORM)); - if ((MASK(in_buf[*index],ASN1_TAG)) == ASN1_TAG) { - /* long form of tag */ - do { - (*index)++; - if (*index >= buf_len) - return ASN1_TAG_ERROR; - tmp_tag = tmp_tag << 7; - tmp_tag += (MASK(in_buf[*index],ASN1_LONG_TAG)); - } while (in_buf[*index] >= 128); - (*index)++; - tag_no = tag_no + tmp_tag; - } else { - tag_no += (MASK(in_buf[*index],ASN1_TAG)); - (*index)++; - } - if (*index >= buf_len) - return ASN1_TAG_ERROR; - return tag_no; -} - - -/* - * int get_value(char *out_buf,unsigned char *in_buf, - * int *msg_index,int in_buf_len) - */ -/* assumes next byte/bytes in in_buf is an encoded BER value preceeded by a BER encoded length. Puts value in out_buf. - */ -int get_value(char *out_buf, - unsigned char *in_buf, - int *msg_index, - int in_buf_len) -{ - int len, lenoflen, indef=0, skip_len; - int ret=0; - int start_index; - -/* printf("get_value 1\n\r"); */ - if (in_buf[*msg_index] < 0x80){ /* short definite length */ - len = in_buf[*msg_index]; -/* printf("short definite length\r\n"); */ - } else if (in_buf[*msg_index] > 0x80) { /* long definite length */ - lenoflen = (in_buf[*msg_index] & 0x7f); /*length of length */ - len = 0; - while (lenoflen--) { - (*msg_index)++; - len = (len << 8) + in_buf[*msg_index]; - } - if (len > (in_buf_len - (*msg_index + 1))) - return ASN1_LEN_ERROR; - } else - indef = 1; - (*msg_index)++; -/* printf("get_value 2: len = %d, *msg_index = %d\r\n",len,*msg_index); */ - if (indef == 1) { - while(!(in_buf[*msg_index]==0 && in_buf[*msg_index + 1]==0)) { - start_index = *msg_index; - skip_len = skip_tag(in_buf,msg_index,in_buf_len); -/* printf("get_value 3: skip_len=%d,start_index=%d,*msg_index=%d\n\r", */ -/* skip_len,start_index,*msg_index); */ - memcpy(&out_buf[ret],&in_buf[start_index],skip_len); - ret += skip_len; - start_index = *msg_index; - skip_len = skip_length_and_value(in_buf,msg_index,in_buf_len); -/* printf("get_value 4: skip_len=%d,start_index=%d,*msg_index=%d\n\r", */ -/* skip_len,start_index,*msg_index); */ - memcpy(&out_buf[ret],&in_buf[start_index],skip_len); - ret += skip_len; - } - return ret; - } - else - memcpy(&out_buf[ret],&in_buf[*msg_index],len); - return len; -} - - -/* - * int get_length(unsigned char *in_buf,int *msg_index) - * assumes next byte/bytes contain a BER encoded length field, - * which is decoded. The value of the length is returned. If it - * is an indefinite length the *indef is set to one. - */ -int get_length(unsigned char *in_buf,int *msg_index, - int *indef,int in_buf_len) -{ - int len=0, lenoflen; - - if (in_buf[*msg_index] < 0x80) /* short definite length */ - len = in_buf[*msg_index]; - else if (in_buf[*msg_index] > 0x80) { /* long definite length */ - lenoflen = (in_buf[*msg_index] & 0x7f); /*length of length */ - len = 0; - while (lenoflen--) { - (*msg_index)++; - len = (len << 8) + in_buf[*msg_index]; - } - if (len > (in_buf_len - (*msg_index + 1))) - return ASN1_LEN_ERROR; - } else - *indef = 1; - (*msg_index)++; - return len; -} diff --git a/lib/asn1/c_src/asn1_erl_nif.c b/lib/asn1/c_src/asn1_erl_nif.c new file mode 100644 index 0000000000..9c9f83bc2a --- /dev/null +++ b/lib/asn1/c_src/asn1_erl_nif.c @@ -0,0 +1,1305 @@ +/* + * %CopyrightBegin% + * + * Copyright Ericsson AB 2002-2011. All Rights Reserved. + * + * The contents of this file are subject to the Erlang Public License, + * Version 1.1, (the "License"); you may not use this file except in + * compliance with the License. You should have received a copy of the + * Erlang Public License along with this software. If not, it can be + * retrieved online at http://www.erlang.org/. + * + * Software distributed under the License is distributed on an "AS IS" + * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See + * the License for the specific language governing rights and limitations + * under the License. + * + * %CopyrightEnd% + * + */ +#include <stdlib.h> +#include <stdio.h> +#include <string.h> +#include "erl_nif.h" + +/* #define ASN1_DEBUG 1 */ + +#define ASN1_OK 0 +#define ASN1_ERROR -1 +#define ASN1_COMPL_ERROR 1 +#define ASN1_MEMORY_ERROR 0 +#define ASN1_DECODE_ERROR 2 +#define ASN1_TAG_ERROR -3 +#define ASN1_LEN_ERROR -4 +#define ASN1_INDEF_LEN_ERROR -5 +#define ASN1_VALUE_ERROR -6 + +#define ASN1_CLASS 0xc0 +#define ASN1_FORM 0x20 +#define ASN1_CLASSFORM (ASN1_CLASS | ASN1_FORM) +#define ASN1_TAG 0x1f +#define ASN1_LONG_TAG 0x7f + +#define ASN1_INDEFINITE_LENGTH 0x80 +#define ASN1_SHORT_DEFINITE_LENGTH 0 + +#define ASN1_PRIMITIVE 0 +#define ASN1_CONSTRUCTED 0x20 + +#define ASN1_NOVALUE 0 + +#define ASN1_SKIPPED 0 +#define ASN1_OPTIONAL 1 +#define ASN1_CHOOSEN 2 + +#define CEIL(X,Y) ((X-1) / Y + 1) + +#define INVMASK(X,M) (X & (M ^ 0xff)) +#define MASK(X,M) (X & M) + +/* PER COMPLETE */ +int per_complete(ErlNifBinary *, unsigned char *, int); + +int per_insert_octets(int, unsigned char **, unsigned char **, int *); + +int per_insert_octets_except_unused(int, unsigned char **, unsigned char **, + int *, int); + +int per_insert_octets_as_bits_exact_len(int, int, unsigned char **, + unsigned char **, int *); + +int per_insert_octets_as_bits(int, unsigned char **, unsigned char **, int *); + +int per_pad_bits(int, unsigned char **, int *); + +int per_insert_least_sign_bits(int, unsigned char, unsigned char **, int *); + +int per_insert_most_sign_bits(int, unsigned char, unsigned char **, int *); + +int per_insert_bits_as_bits(int, int, unsigned char **, unsigned char **, int *); + +int per_insert_octets_unaligned(int, unsigned char **, unsigned char **, int); + +int per_realloc_memory(ErlNifBinary *, int, unsigned char **); + +/* BER DECODE */ +int ber_decode_begin(ErlNifEnv *, ERL_NIF_TERM *, unsigned char *, int, + unsigned int *); + +int ber_decode(ErlNifEnv *, ERL_NIF_TERM *, unsigned char *, int *, int); + +int ber_decode_tag(ErlNifEnv *, ERL_NIF_TERM *, unsigned char *, int, int *); + +int ber_decode_value(ErlNifEnv*, ERL_NIF_TERM *, unsigned char *, int *, int, + int); + +/* BER ENCODE */ +typedef struct ber_encode_mem_chunk mem_chunk_t; + +int ber_encode(ErlNifEnv *, ERL_NIF_TERM , mem_chunk_t **, unsigned int *); + +void ber_free_chunks(mem_chunk_t *chunk); +mem_chunk_t *ber_new_chunk(unsigned int length); +int ber_check_memory(mem_chunk_t **curr, unsigned int needed); + +int ber_encode_tag(ErlNifEnv *, ERL_NIF_TERM , unsigned int , + mem_chunk_t **, unsigned int *); + +int ber_encode_length(size_t , mem_chunk_t **, unsigned int *); + +/* + * + * This section defines functionality for the complete encode of a + * PER encoded message + * + */ + +int per_complete(ErlNifBinary *out_binary, unsigned char *in_buf, + int in_buf_len) { + int counter = in_buf_len; + /* counter keeps track of number of bytes left in the + input buffer */ + + int buf_space = in_buf_len; + /* This is the amount of allocated space left of the out_binary. It + is possible when padding is applied that more space is needed than + was originally allocated. */ + + int buf_size = in_buf_len; + /* Size of the buffer. May become reallocated and thus other than + in_buf_len */ + + unsigned char *in_ptr, *ptr; + /* in_ptr points at the next byte in in_buf to be moved to + complete_buf. + ptr points into the new completed buffer, complete_buf, at the + position of the next byte that will be set */ + int unused = 8; + /* unused = [1,...,8] indicates how many of the rigthmost bits of + the byte that ptr points at that are unassigned */ + + int no_bits, no_bytes, in_unused, desired_len, ret, saved_mem, needed, + pad_bits; + + unsigned char val; + + in_ptr = in_buf; + ptr = out_binary->data; + *ptr = 0x00; + while (counter > 0) { + counter--; + switch (*in_ptr) { + case 0: + /* just one zero-bit should be added to the buffer */ + if (unused == 1) { + unused = 8; + *++ptr = 0x00; + buf_space--; + } else + unused--; + break; + + case 1: + /* one one-bit should be added to the buffer */ + if (unused == 1) { + *ptr = *ptr | 1; + unused = 8; + *++ptr = 0x00; + buf_space--; + } else { + *ptr = *ptr | (1 << (unused - 1)); + unused--; + } + break; + + case 2: + /* align buffer to end of byte */ + if (unused != 8) { + *++ptr = 0x00; + buf_space--; + unused = 8; + } + break; + + case 10: + /* next byte in in_buf tells how many bits in the second next + byte that will be used */ + /* The leftmost unused bits in the value byte are supposed to be + zero bits */ + no_bits = (int) *(++in_ptr); + val = *(++in_ptr); + counter -= 2; + if ((ret = per_insert_least_sign_bits(no_bits, val, &ptr, &unused)) + == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 20: + /* in this case the next value in_ptr points at holds the number + of following bytes that holds the value that will be inserted + in the completed buffer */ + no_bytes = (int) *(++in_ptr); + counter -= (no_bytes + 1); + if ((counter < 0) + || (ret = per_insert_octets(no_bytes, &in_ptr, &ptr, + &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 21: + /* in this case the next two bytes in_ptr points at holds the number + of following bytes that holds the value that will be inserted + in the completed buffer */ + no_bytes = (int) *(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int) *(++in_ptr); + counter -= (2 + no_bytes); + if ((counter < 0) + || (ret = per_insert_octets(no_bytes, &in_ptr, &ptr, + &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 30: + /* If we call the following bytes, in the buffer in_ptr points at, + By1,By2,Rest then Rest is the value that will be transfered to + the completed buffer. By1 tells how many of the rightmost bits in + Rest that should not be used. By2 is the length of Rest in bytes.*/ + in_unused = (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + counter -= (2 + no_bytes); + ret = -4711; + if ((counter < 0) + || (ret = per_insert_octets_except_unused(no_bytes, &in_ptr, + &ptr, &unused, in_unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 31: + /* If we call the following bytes, in the buffer in_ptr points at, + By1,By2,By3,Rest then Rest is the value that will be transfered to + the completed buffer. By1 tells how many of the rightmost bits in + Rest that should not be used. By2 and By3 is the length of + Rest in bytes.*/ + in_unused = (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int) *(++in_ptr); + counter -= (3 + no_bytes); + if ((counter < 0) + || (ret = per_insert_octets_except_unused(no_bytes, &in_ptr, + &ptr, &unused, in_unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 40: + /* This case implies that next byte,By1,(..,By1,By2,Bin,...) + is the desired length of the completed value, maybe needs + padding zero bits or removal of trailing zero bits from Bin. + By2 is the length of Bin and Bin is the value that will be + put into the completed buffer. Each byte in Bin has the value + 1 or 0.*/ + desired_len = (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + + /* This is the algorithm for need of memory reallocation: + Only when padding (cases 40 - 43,45 - 47) more memory may be + used than allocated. Therefore one has to keep track of how + much of the allocated memory that has been saved, i.e. the + difference between the number of parsed bytes of the input buffer + and the number of used bytes of the output buffer. + If saved memory is less than needed for the padding then we + need more memory. */ + saved_mem = buf_space - counter; + pad_bits = desired_len - no_bytes - unused; + needed = (pad_bits > 0) ? CEIL(pad_bits,8) : 0; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (2 + no_bytes); + if ((counter < 0) + || (ret = per_insert_octets_as_bits_exact_len(desired_len, + no_bytes, &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 41: + /* Same as case 40 apart from By2, the length of Bin, which is in + two bytes*/ + desired_len = (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int) *(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (3 + no_bytes); + if ((counter < 0) + || (ret = per_insert_octets_as_bits_exact_len(desired_len, + no_bytes, &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 42: + /* Same as case 40 apart from By1, the desired length, which is in + two bytes*/ + desired_len = (int) *(++in_ptr); + desired_len = desired_len << 8; + desired_len = desired_len | (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (3 + no_bytes); + if ((counter < 0) + || (ret = per_insert_octets_as_bits_exact_len(desired_len, + no_bytes, &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 43: + /* Same as case 40 apart from By1 and By2, the desired length and + the length of Bin, which are in two bytes each. */ + desired_len = (int) *(++in_ptr); + desired_len = desired_len << 8; + desired_len = desired_len | (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int) *(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (4 + no_bytes); + if ((counter < 0) + || (ret = per_insert_octets_as_bits_exact_len(desired_len, + no_bytes, &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 45: + /* This case assumes that the following bytes in the incoming buffer + (called By1,By2,Bin) is By1, which is the number of bits (n) that + will be inserted in the completed buffer. By2 is the number of + bytes in Bin. Each bit in the buffer Bin should be inserted from + the leftmost until the nth.*/ + desired_len = (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (2 + no_bytes); + + if ((counter < 0) + || (ret = per_insert_bits_as_bits(desired_len, no_bytes, + &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 46: + /* Same as case 45 apart from By1, the desired length, which is + in two bytes. */ + desired_len = (int) *(++in_ptr); + desired_len = desired_len << 8; + desired_len = desired_len | (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (3 + no_bytes); + if ((counter < 0) + || (ret = per_insert_bits_as_bits(desired_len, no_bytes, + &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + case 47: + /* Same as case 45 apart from By1 and By2, the desired length + and the length of Bin, which are in two bytes each. */ + desired_len = (int) *(++in_ptr); + desired_len = desired_len << 8; + desired_len = desired_len | (int) *(++in_ptr); + no_bytes = (int) *(++in_ptr); + no_bytes = no_bytes << 8; + no_bytes = no_bytes | (int) *(++in_ptr); + + saved_mem = buf_space - counter; + needed = CEIL((desired_len-unused),8) - no_bytes; + if (saved_mem < needed) { + /* Have to allocate more memory */ + buf_size += needed; + buf_space += needed; + if (per_realloc_memory(out_binary, buf_size, &ptr) == ASN1_ERROR + ) + return ASN1_ERROR; + } + + counter -= (4 + no_bytes); + if ((counter < 0) + || (ret = per_insert_bits_as_bits(desired_len, no_bytes, + &in_ptr, &ptr, &unused)) == ASN1_ERROR + ) + return ASN1_ERROR; + buf_space -= ret; + break; + + default: + return ASN1_ERROR; + } + in_ptr++; + } + /* The returned buffer must be at least one byte and + it must be octet aligned */ + if ((unused == 8) && (ptr != out_binary->data)) + return (ptr - out_binary->data); + else { + ptr++; /* octet align buffer */ + return (ptr - out_binary->data); + } +} + +int per_realloc_memory(ErlNifBinary *binary, int amount, unsigned char **ptr) { + + int i = *ptr - binary->data; + + if (!enif_realloc_binary(binary, amount)) { + /*error handling due to memory allocation failure */ + return ASN1_ERROR; + } else { + *ptr = binary->data + i; + } + return ASN1_OK; +} + +int per_insert_most_sign_bits(int no_bits, unsigned char val, + unsigned char **output_ptr, int *unused) { + unsigned char *ptr = *output_ptr; + + if (no_bits < *unused) { + *ptr = *ptr | (val >> (8 - *unused)); + *unused -= no_bits; + } else if (no_bits == *unused) { + *ptr = *ptr | (val >> (8 - *unused)); + *unused = 8; + *++ptr = 0x00; + } else { + *ptr = *ptr | (val >> (8 - *unused)); + *++ptr = 0x00; + *ptr = *ptr | (val << *unused); + *unused = 8 - (no_bits - *unused); + } + *output_ptr = ptr; + return ASN1_OK; +} + +int per_insert_least_sign_bits(int no_bits, unsigned char val, + unsigned char **output_ptr, int *unused) { + unsigned char *ptr = *output_ptr; + int ret = 0; + + if (no_bits < *unused) { + *ptr = *ptr | (val << (*unused - no_bits)); + *unused -= no_bits; + } else if (no_bits == *unused) { + *ptr = *ptr | val; + *unused = 8; + *++ptr = 0x00; + ret++; + } else { + /* first in the begun byte in the completed buffer insert + so many bits that fit, then insert the rest in next byte.*/ + *ptr = *ptr | (val >> (no_bits - *unused)); + *++ptr = 0x00; + ret++; + *ptr = *ptr | (val << (8 - (no_bits - *unused))); + *unused = 8 - (no_bits - *unused); + } + *output_ptr = ptr; + return ret; +} + +/* per_pad_bits adds no_bits bits in the buffer that output_ptr + points at. + */ +int per_pad_bits(int no_bits, unsigned char **output_ptr, int *unused) { + unsigned char *ptr = *output_ptr; + int ret = 0; + + while (no_bits > 0) { + if (*unused == 1) { + *unused = 8; + *++ptr = 0x00; + ret++; + } else + (*unused)--; + no_bits--; + } + *output_ptr = ptr; + return ret; +} + +/* insert_bits_as_bits removes no_bytes bytes from the buffer that in_ptr + points at and takes the desired_no leftmost bits from those removed + bytes and inserts them in the buffer(output buffer) that ptr points at. + The unused parameter tells how many bits that are not set in the + actual byte in the output buffer. If desired_no is more bits than the + input buffer has in no_bytes bytes, then zero bits is padded.*/ +int per_insert_bits_as_bits(int desired_no, int no_bytes, + unsigned char **input_ptr, unsigned char **output_ptr, int *unused) { + unsigned char *in_ptr = *input_ptr; + unsigned char val; + int no_bits, ret, ret2; + + if (desired_no == (no_bytes * 8)) { + if (per_insert_octets_unaligned(no_bytes, &in_ptr, output_ptr, *unused) + == ASN1_ERROR + ) + return ASN1_ERROR; + ret = no_bytes; + } else if (desired_no < (no_bytes * 8)) { + /* printf("per_insert_bits_as_bits 1\n\r"); */ + if (per_insert_octets_unaligned(desired_no / 8, &in_ptr, output_ptr, + *unused) == ASN1_ERROR + ) + return ASN1_ERROR; + /* printf("per_insert_bits_as_bits 2\n\r"); */ + val = *++in_ptr; + /* printf("val = %d\n\r",(int)val); */ + no_bits = desired_no % 8; + /* printf("no_bits = %d\n\r",no_bits); */ + per_insert_most_sign_bits(no_bits, val, output_ptr, unused); + ret = CEIL(desired_no,8); + } else { + if (per_insert_octets_unaligned(no_bytes, &in_ptr, output_ptr, *unused) + == ASN1_ERROR + ) + return ASN1_ERROR; + ret2 = per_pad_bits(desired_no - (no_bytes * 8), output_ptr, unused); + /* printf("ret2 = %d\n\r",ret2); */ + ret = CEIL(desired_no,8); + /* printf("ret = %d\n\r",ret); */ + } + /* printf("*unused = %d\n\r",*unused); */ + *input_ptr = in_ptr; + return ret; +} + +/* per_insert_octets_as_bits_exact_len */ +int per_insert_octets_as_bits_exact_len(int desired_len, int in_buff_len, + unsigned char **in_ptr, unsigned char **ptr, int *unused) { + int ret = 0; + int ret2 = 0; + + if (desired_len == in_buff_len) { + if ((ret = per_insert_octets_as_bits(in_buff_len, in_ptr, ptr, unused)) + == ASN1_ERROR + ) + return ASN1_ERROR; + } else if (desired_len > in_buff_len) { + if ((ret = per_insert_octets_as_bits(in_buff_len, in_ptr, ptr, unused)) + == ASN1_ERROR + ) + return ASN1_ERROR; + /* now pad with zero bits */ + /* printf("~npad_bits: called with %d bits padding~n~n~r",desired_len - in_buff_len); */ + if ((ret2 = per_pad_bits(desired_len - in_buff_len, ptr, unused)) + == ASN1_ERROR + ) + return ASN1_ERROR; + } else {/* desired_len < no_bits */ + if ((ret = per_insert_octets_as_bits(desired_len, in_ptr, ptr, unused)) + == ASN1_ERROR + ) + return ASN1_ERROR; + /* now remove no_bits - desired_len bytes from in buffer */ + *in_ptr += (in_buff_len - desired_len); + } + return (ret + ret2); +} + +/* insert_octets_as_bits takes no_bytes bytes from the buffer that input_ptr + points at and inserts the least significant bit of it in the buffer that + output_ptr points at. Each byte in the input buffer must be 1 or 0 + otherwise the function returns ASN1_ERROR. The output buffer is concatenated + without alignment. + */ +int per_insert_octets_as_bits(int no_bytes, unsigned char **input_ptr, + unsigned char **output_ptr, int *unused) { + unsigned char *in_ptr = *input_ptr; + unsigned char *ptr = *output_ptr; + int used_bits = 8 - *unused; + + while (no_bytes > 0) { + switch (*++in_ptr) { + case 0: + if (*unused == 1) { + *unused = 8; + *++ptr = 0x00; + } else + (*unused)--; + break; + case 1: + if (*unused == 1) { + *ptr = *ptr | 1; + *unused = 8; + *++ptr = 0x00; + } else { + *ptr = *ptr | (1 << (*unused - 1)); + (*unused)--; + } + break; + default: + return ASN1_ERROR; + } + no_bytes--; + } + *input_ptr = in_ptr; + *output_ptr = ptr; + return ((used_bits + no_bytes) / 8); /*return number of new bytes + in completed buffer */ +} + +/* insert_octets inserts bytes from the input buffer, *input_ptr, + into the output buffer, *output_ptr. Before the first byte is + inserted the input buffer is aligned. + */ +int per_insert_octets(int no_bytes, unsigned char **input_ptr, + unsigned char **output_ptr, int *unused) { + unsigned char *in_ptr = *input_ptr; + unsigned char *ptr = *output_ptr; + int ret = 0; + + if (*unused != 8) {/* must align before octets are added */ + *++ptr = 0x00; + ret++; + *unused = 8; + } + while (no_bytes > 0) { + *ptr = *(++in_ptr); + *++ptr = 0x00; + /* *unused = *unused - 1; */ + no_bytes--; + } + *input_ptr = in_ptr; + *output_ptr = ptr; + return (ret + no_bytes); +} + +/* per_insert_octets_unaligned inserts bytes from the input buffer, *input_ptr, + into the output buffer, *output_ptr.No alignment is done. + */ +int per_insert_octets_unaligned(int no_bytes, unsigned char **input_ptr, + unsigned char **output_ptr, int unused) { + unsigned char *in_ptr = *input_ptr; + unsigned char *ptr = *output_ptr; + int n = no_bytes; + unsigned char val; + + while (n > 0) { + if (unused == 8) { + *ptr = *++in_ptr; + *++ptr = 0x00; + } else { + val = *++in_ptr; + *ptr = *ptr | val >> (8 - unused); + *++ptr = 0x00; + *ptr = val << unused; + } + n--; + } + *input_ptr = in_ptr; + *output_ptr = ptr; + return no_bytes; +} + +int per_insert_octets_except_unused(int no_bytes, unsigned char **input_ptr, + unsigned char **output_ptr, int *unused, int in_unused) { + unsigned char *in_ptr = *input_ptr; + unsigned char *ptr = *output_ptr; + int val, no_bits; + int ret = 0; + + if (in_unused == 0) { + if ((ret = per_insert_octets_unaligned(no_bytes, &in_ptr, &ptr, *unused)) + == ASN1_ERROR + ) + return ASN1_ERROR; + } else { + if ((ret = per_insert_octets_unaligned(no_bytes - 1, &in_ptr, &ptr, *unused)) + != ASN1_ERROR) { + val = (int) *(++in_ptr); + no_bits = 8 - in_unused; + /* no_bits is always less than *unused since the buffer is + octet aligned after insert:octets call, so the following + if clasuse is obsolete I think */ + if (no_bits < *unused) { + *ptr = *ptr | (val >> (8 - *unused)); + *unused = *unused - no_bits; + } else if (no_bits == *unused) { + *ptr = *ptr | (val >> (8 - *unused)); + *++ptr = 0x00; + ret++; + *unused = 8; + } else { + *ptr = *ptr | (val >> (8 - *unused)); + *++ptr = 0x00; + ret++; + *ptr = *ptr | (val << *unused); + *unused = 8 - (no_bits - *unused); + } + } else + return ASN1_ERROR; + } + *input_ptr = in_ptr; + *output_ptr = ptr; + return ret; +} + +/* + * + * This section defines functionality for the partial decode of a + * BER encoded message + * + */ + +/* + * int decode(ErlNifEnv* env, ERL_NIF_TERM *term, unsigned char *in_buf, + int in_buf_len, unsigned int *err_pos) + * term is a pointer to the term which is to be returned to erlang + * in_buf is a pointer into the buffer of incoming bytes. + * in_buf_len is the length of the incoming buffer. + * The function reads the bytes in the incoming buffer and structures + * it in a nested way as Erlang terms. The buffer contains data in the + * order tag - length - value. Tag, length and value has the following + * format: + * A tag is normally one byte but may be of any length, if the tag number + * is greater than 30. +----------+ + * |CL|C|NNNNN| + * +----------+ + * If NNNNN is 31 then will the 7 l.s.b of each of the following tag number + * bytes contain the tag number. Each tag number byte that is not the last one + * has the m.s.b. set to 1. + * The length can be short definite length (sdl), long definite length (ldl) + * or indefinite length (il). + * sdl: +---------+ the L bits is the length + * |0|LLLLLLL| + * +---------+ + * ldl: +---------+ +---------+ +---------+ +-----------+ + * |1|lllllll| |first len| | | |the Nth len| + * +---------+ +---------+ +---------+ ... +-----------+ + * The first byte tells how many len octets will follow, max 127 + * il: +---------+ +----------------------+ +--------+ +--------+ + * |1|0000000| |content octets (Value)| |00000000| |00000000| + * +---------+ +----------------------+ +--------+ +--------+ + * The value octets are preceded by one octet and followed by two + * exactly as above. The value must be some tag-length-value encoding. + * + * The function returns a value in Erlang nif term format: + * {{TagNo,Value},Rest} + * TagNo is an integer ((CL bsl 16) + tag number) which limits the tag number + * to 65535. + * Value is a binary if the C bit in tag was unset, otherwise (if tag was + * constructed) Value is a list, List. + * List is like: [{TagNo,Value},{TagNo,Value},...] + * Rest is a binary, i.e. the undecoded part of the buffer. Most often Rest + * is the empty binary. + * If some error occured during the decoding of the in_buf an error is returned. + */ +int ber_decode_begin(ErlNifEnv* env, ERL_NIF_TERM *term, unsigned char *in_buf, + int in_buf_len, unsigned int *err_pos) { + int maybe_ret; + int ib_index = 0; + unsigned char *rest_data; + ERL_NIF_TERM decoded_term, rest; + + if ((maybe_ret = ber_decode(env, &decoded_term, in_buf, &ib_index, + in_buf_len)) <= ASN1_ERROR) + { + *err_pos = ib_index; + return maybe_ret; + }; + + // The remaining binary after one ASN1 segment has been decoded + if ((rest_data = enif_make_new_binary(env, in_buf_len - ib_index, &rest)) + == NULL) { + *term = enif_make_atom(env, "could_not_alloc_binary"); + return ASN1_ERROR; + } + + *term = enif_make_tuple2(env, decoded_term, rest); + return ASN1_OK; +} + +int ber_decode(ErlNifEnv* env, ERL_NIF_TERM *term, unsigned char *in_buf, + int *ib_index, int in_buf_len) { + int maybe_ret; + int form; + ERL_NIF_TERM tag, value; + + /*buffer must hold at least two bytes*/ + if ((*ib_index + 2) > in_buf_len) + return ASN1_VALUE_ERROR; + /* "{{TagNo," */ + if ((form = ber_decode_tag(env, &tag, in_buf, in_buf_len, ib_index)) + <= ASN1_ERROR + ) + return form; /* 5 bytes */ + if (*ib_index >= in_buf_len) { + return ASN1_TAG_ERROR; + } + /* buffer must hold at least one byte (0 as length and nothing as + value) */ + /* "{{TagNo,Value}," */ + if ((maybe_ret = ber_decode_value(env, &value, in_buf, ib_index, form, + in_buf_len)) <= ASN1_ERROR + ) + return maybe_ret; /* at least 5 bytes */ + *term = enif_make_tuple2(env, tag, value); + return ASN1_OK; +} + +/* + * decode_tag decodes the BER encoded tag in in_buf and creates an + * nif term tag + */ +int ber_decode_tag(ErlNifEnv* env, ERL_NIF_TERM *tag, unsigned char *in_buf, + int in_buf_len, int *ib_index) { + int tag_no, tmp_tag, form; + + /* first get the class of tag and bit shift left 16*/ + tag_no = ((MASK(in_buf[*ib_index],ASN1_CLASS)) << 10); + + form = (MASK(in_buf[*ib_index],ASN1_FORM)); + + /* then get the tag number */ + if ((tmp_tag = (int) INVMASK(in_buf[*ib_index],ASN1_CLASSFORM)) < 31) { + *tag = enif_make_uint(env, tag_no + tmp_tag); + (*ib_index)++; + } else { + int n = 0; /* n is used to check that the 64K limit is not + exceeded*/ + + /* should check that at least three bytes are left in + in-buffer,at least two tag byte and at least one length byte */ + if ((*ib_index + 3) > in_buf_len) + return ASN1_VALUE_ERROR; + (*ib_index)++; + /* The tag is in the following bytes in in_buf as + 1ttttttt 1ttttttt ... 0ttttttt, where the t-bits + is the tag number*/ + /* In practice is the tag size limited to 64K, i.e. 16 bits. If + the tag is greater then 64K return an error */ + while (((tmp_tag = (int) in_buf[*ib_index]) >= 128) && n < 2) { + /* m.s.b. = 1 */ + tag_no = tag_no + (MASK(tmp_tag,ASN1_LONG_TAG) << 7); + (*ib_index)++; + n++; + }; + if ((n == 2) && in_buf[*ib_index] > 3) + return ASN1_TAG_ERROR; /* tag number > 64K */ + tag_no = tag_no + in_buf[*ib_index]; + (*ib_index)++; + *tag = enif_make_uint(env, tag_no); + } + return form; +} + +/* + * ber_decode_value decodes the BER encoded length and value fields in the + * in_buf and puts the value part in the decode_buf as an Erlang + * nif term into value + */ +int ber_decode_value(ErlNifEnv* env, ERL_NIF_TERM *value, unsigned char *in_buf, + int *ib_index, int form, int in_buf_len) { + int maybe_ret; + unsigned int len = 0; + unsigned int lenoflen = 0; + int indef = 0; + unsigned char *tmp_out_buff; + ERL_NIF_TERM term = 0, curr_head = 0; + + if (((in_buf[*ib_index]) & 0x80) == ASN1_SHORT_DEFINITE_LENGTH) { + len = in_buf[*ib_index]; + } else if (in_buf[*ib_index] == ASN1_INDEFINITE_LENGTH + ) + indef = 1; + else /* long definite length */{ + lenoflen = (in_buf[*ib_index] & 0x7f); /*length of length */ + if (lenoflen > (in_buf_len - (*ib_index + 1))) + return ASN1_LEN_ERROR; + len = 0; + while (lenoflen--) { + (*ib_index)++; + if (!(len < (1 << (sizeof(len) - 1) * 8))) + return ASN1_LEN_ERROR; /* length does not fit in 32 bits */ + len = (len << 8) + in_buf[*ib_index]; + } + } + if (len > (in_buf_len - (*ib_index + 1))) + return ASN1_VALUE_ERROR; + (*ib_index)++; + if (indef == 1) { /* in this case it is desireably to check that indefinite length + end bytes exist in inbuffer */ + curr_head = enif_make_list(env, 0); + while (!(in_buf[*ib_index] == 0 && in_buf[*ib_index + 1] == 0)) { + if (*ib_index >= in_buf_len) + return ASN1_INDEF_LEN_ERROR; + + if ((maybe_ret = ber_decode(env, &term, in_buf, ib_index, in_buf_len)) + <= ASN1_ERROR + ) + return maybe_ret; + curr_head = enif_make_list_cell(env, term, curr_head); + } + enif_make_reverse_list(env, curr_head, value); + (*ib_index) += 2; /* skip the indefinite length end bytes */ + } else if (form == ASN1_CONSTRUCTED) + { + int end_index = *ib_index + len; + if (end_index > in_buf_len) + return ASN1_LEN_ERROR; + curr_head = enif_make_list(env, 0); + while (*ib_index < end_index) { + + if ((maybe_ret = ber_decode(env, &term, in_buf, ib_index, + in_buf_len)) <= ASN1_ERROR + ) + return maybe_ret; + curr_head = enif_make_list_cell(env, term, curr_head); + } + enif_make_reverse_list(env, curr_head, value); + } else { + if ((*ib_index + len) > in_buf_len) + return ASN1_LEN_ERROR; + tmp_out_buff = enif_make_new_binary(env, len, value); + memcpy(tmp_out_buff, in_buf + *ib_index, len); + *ib_index = *ib_index + len; + } + return ASN1_OK; +} + +struct ber_encode_mem_chunk { + mem_chunk_t *next; + int length; + char *top; + char *curr; +}; + +int ber_encode(ErlNifEnv *env, ERL_NIF_TERM term, mem_chunk_t **curr, unsigned int *count) { + + const ERL_NIF_TERM *tv; + unsigned int form; + int arity; + + if (!enif_get_tuple(env, term, &arity, &tv)) + return ASN1_ERROR; + + form = enif_is_list(env, tv[1]) ? ASN1_CONSTRUCTED : ASN1_PRIMITIVE; + + switch (form) { + case ASN1_PRIMITIVE: { + ErlNifBinary value; + if (!enif_inspect_binary(env, tv[1], &value)) + return ASN1_ERROR; + + if (ber_check_memory(curr, value.size)) + return ASN1_ERROR; + memcpy((*curr)->curr - value.size + 1, value.data, value.size); + (*curr)->curr -= value.size; + *count += value.size; + + if (ber_encode_length(value.size, curr, count)) + return ASN1_ERROR; + + break; + } + case ASN1_CONSTRUCTED: { + ERL_NIF_TERM head, tail; + unsigned int tmp_cnt; + + if(!enif_make_reverse_list(env, tv[1], &head)) + return ASN1_ERROR; + + if (!enif_get_list_cell(env, head, &head, &tail)) { + if (enif_is_empty_list(env, tv[1])) { + *((*curr)->curr) = 0; + (*curr)->curr -= 1; + (*count)++; + break; + } else + return ASN1_ERROR; + } + + do { + tmp_cnt = 0; + if (ber_encode(env, head, curr, &tmp_cnt)) { + return ASN1_ERROR; + } + *count += tmp_cnt; + } while (enif_get_list_cell(env, tail, &head, &tail)); + + if (ber_check_memory(curr, *count)) { + return ASN1_ERROR; + } + + if (ber_encode_length(*count, curr, count)) { + return ASN1_ERROR; + } + + break; + } + } + + // We need atleast 5 bytes to encode the next tlv + if (ber_check_memory(curr, 3)) + return ASN1_ERROR; + + if (ber_encode_tag(env, tv[0], form, curr, count)) + return ASN1_ERROR; + + return ASN1_OK; +} + +int ber_encode_tag(ErlNifEnv *env, ERL_NIF_TERM tag, unsigned int form, + mem_chunk_t **curr, unsigned int *count) { + unsigned int class_tag_no, head_tag; + if (!enif_get_uint(env, tag, &class_tag_no)) + return ASN1_ERROR; + + head_tag = form | ((class_tag_no & 0x30000) >> 10); + class_tag_no = class_tag_no & 0xFFFF; + + if (class_tag_no <= 30) { + *(*curr)->curr = head_tag | class_tag_no; + (*curr)->curr -= 1; + (*count)++; + return ASN1_OK; + } else { + *(*curr)->curr = class_tag_no & 127; + class_tag_no = class_tag_no >> 7; + (*curr)->curr -= 1; + (*count)++; + + while (class_tag_no > 0) { + *(*curr)->curr = (class_tag_no & 127) | 0x80; + class_tag_no >>= 7; + (*curr)->curr -= 1; + (*count)++; + } + + *(*curr)->curr = head_tag | 0x1F; + (*curr)->curr -= 1; + (*count)++; + + return ASN1_OK; + } +} + +int ber_encode_length(size_t size, mem_chunk_t **curr, unsigned int *count) { + if (size < 128) { + if (ber_check_memory(curr, 1u)) + return ASN1_ERROR; + *(*curr)->curr = size; + (*curr)->curr -= 1; + (*count)++; + } else { + int chunks = size / 256 + 1; + if (ber_check_memory(curr, chunks + 1)) + return ASN1_ERROR; + + while (size > 0) + { + *(*curr)->curr = size & 0xFF; + size >>= 8; + (*curr)->curr -= 1; + (*count)++; + } + + *(*curr)->curr = chunks | 0x80; + (*curr)->curr -= 1; + (*count)++; + } + return ASN1_OK; +} + +mem_chunk_t *ber_new_chunk(unsigned int length) { + mem_chunk_t *new = enif_alloc(sizeof(mem_chunk_t)); + if (new == NULL) + return NULL; + new->next = NULL; + new->top = enif_alloc(sizeof(char) * length); + if (new->top == NULL) { + free(new); + return NULL; + } + new->curr = new->top + length - 1; + new->length = length; + return new; +} + +void ber_free_chunks(mem_chunk_t *chunk) { + mem_chunk_t *curr, *next = chunk; + while (next != NULL) { + curr = next; + next = curr->next; + enif_free(curr->top); + enif_free(curr); + } +} + +int ber_check_memory(mem_chunk_t **curr, unsigned int needed) { + mem_chunk_t *new; + if ((*curr)->curr-needed >= (*curr)->top) + return ASN1_OK; + + if ((new = ber_new_chunk((*curr)->length > needed ? (*curr)->length * 2 : (*curr)->length + needed)) == NULL) + return ASN1_ERROR; + new->next = *curr; + *curr = new; + return ASN1_OK; +} + +static ERL_NIF_TERM encode_per_complete(ErlNifEnv* env, int argc, + const ERL_NIF_TERM argv[]) { + ERL_NIF_TERM err_code; + ErlNifBinary in_binary; + ErlNifBinary out_binary; + int complete_len; + if (!enif_inspect_iolist_as_binary(env, argv[0], &in_binary)) + return enif_make_atom(env, "badarg"); + + if (!enif_alloc_binary(in_binary.size, &out_binary)) + return enif_make_atom(env, "alloc_binary_failed"); + + if (in_binary.size == 0) + return enif_make_binary(env, &out_binary); + + if ((complete_len = per_complete(&out_binary, in_binary.data, + in_binary.size)) <= ASN1_ERROR) { + enif_release_binary(&out_binary); + if (complete_len == ASN1_ERROR + ) + err_code = enif_make_uint(env, '1'); + else + err_code = enif_make_uint(env, 0); + return enif_make_tuple2(env, enif_make_atom(env, "error"), err_code); + } + if (complete_len < out_binary.size) + enif_realloc_binary(&out_binary, complete_len); + + return enif_make_binary(env, &out_binary); +} + +static ERL_NIF_TERM decode_ber_tlv(ErlNifEnv* env, int argc, + const ERL_NIF_TERM argv[]) { + ErlNifBinary in_binary; + ERL_NIF_TERM return_term; + unsigned int err_pos = 0, return_code; + + if (!enif_inspect_iolist_as_binary(env, argv[0], &in_binary)) + return enif_make_badarg(env); + + if ((return_code = ber_decode_begin(env, &return_term, in_binary.data, + in_binary.size, &err_pos)) != ASN1_OK + ) + return enif_make_tuple2(env, enif_make_atom(env,"error"), enif_make_tuple2(env, + enif_make_int(env, return_code),enif_make_int(env, err_pos))); + return return_term; +} + +static ERL_NIF_TERM encode_ber_tlv(ErlNifEnv* env, int argc, + const ERL_NIF_TERM argv[]) { + ErlNifBinary out_binary; + unsigned int length = 0, pos = 0; + int encode_err; + mem_chunk_t *curr, *top; + ERL_NIF_TERM err_code; + + curr = ber_new_chunk(40); + + if ((encode_err = ber_encode(env, argv[0], &curr, &length)) + <= ASN1_ERROR) { + ber_free_chunks(curr); + err_code = enif_make_int(env, encode_err); + return enif_make_tuple2(env, enif_make_atom(env, "error"), err_code); + } + + if (!enif_alloc_binary(length, &out_binary)) { + ber_free_chunks(curr); + return enif_make_tuple2(env, enif_make_atom(env, "error"), enif_make_atom(env,"oom")); + } + + top = curr; + + while (curr != NULL) { + length = curr->length - (curr->curr-curr->top) -1; + if (length > 0) + memcpy(out_binary.data + pos, curr->curr+1, length); + pos += length; + curr = curr->next; + } + + ber_free_chunks(top); + + return enif_make_binary(env, &out_binary); +} + +static int is_ok_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info) { + int i; + return enif_get_int(env, load_info, &i) && i == 1; +} + +static int load(ErlNifEnv* env, void** priv_data, ERL_NIF_TERM load_info) { + if (!is_ok_load_info(env, load_info)) + return -1; + return 0; +} + +static int upgrade(ErlNifEnv* env, void** priv_data, void** old_priv_data, + ERL_NIF_TERM load_info) { + if (!is_ok_load_info(env, load_info)) + return -1; + return 0; +} + +static void unload(ErlNifEnv* env, void* priv_data) { + +} + +static ErlNifFunc nif_funcs[] = { { "encode_per_complete", 1, + encode_per_complete }, { "decode_ber_tlv", 1, decode_ber_tlv }, { + "encode_ber_tlv", 1, encode_ber_tlv } }; + +ERL_NIF_INIT(asn1rt_nif, nif_funcs, load, NULL, upgrade, unload) diff --git a/lib/asn1/doc/src/asn1_spec.xmlsrc b/lib/asn1/doc/src/asn1_spec.xmlsrc index 8d61834da8..07cba17816 100644 --- a/lib/asn1/doc/src/asn1_spec.xmlsrc +++ b/lib/asn1/doc/src/asn1_spec.xmlsrc @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2009</year> + <year>2003</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -43,7 +43,7 @@ <p>So far this functionality is only provided when using the optimized BER_BIN version, that is when compiling with the options <c>ber_bin</c> and <c>optimize</c>. It does also work - using the <c>driver</c> option. We have no intent to make this + using the <c>nif</c> option. We have no intent to make this available on the default BER version, but maybe in the PER_BIN version (<c>per_bin</c>). </p> @@ -661,7 +661,9 @@ ValAction = {'Action',17,{'Button',4711,false}}. <p>The ASN.1 specs in the test are compiled with the options <c>ber_bin, optimize, driver</c> and <c>asn1config</c>. If the <c>driver</c> option had been omitted there should have been - higher values for <c>decode</c> and <c>decode_part</c>. + higher values for <c>decode</c> and <c>decode_part</c>. These tests have + not been re-run using nifs, but are expected to perform about 5% better + than the linked-in driver. </p> <p>The test program runs 10000 decodes on the value, resulting in a printout with the elapsed time in microseconds for the diff --git a/lib/asn1/doc/src/asn1_ug.xml b/lib/asn1/doc/src/asn1_ug.xml index 12d986308f..1b399fb641 100644 --- a/lib/asn1/doc/src/asn1_ug.xml +++ b/lib/asn1/doc/src/asn1_ug.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1997</year><year>2010</year> + <year>1997</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -347,7 +347,7 @@ erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn <p>This flag has effect only when used together with one of <c>per_bin</c> or <c>ber_bin</c> flags. It gives time optimized code in the generated modules and it uses another runtime module. - In the <c>per_bin</c> case a linked-in driver is used. The + In the <c>per_bin</c> case a nif is used. The result from an encode is a binary.</p> <p><em>When this flag is used you cannot use the old format</em><c>{TypeName,Value}</c> when you encode values. Since it is an unnecessary construct it has been removed in favor of @@ -362,9 +362,14 @@ erlc -o ../asnfiles -I ../asnfiles -I /usr/local/standards/asn1 Person.asn </item> <tag><c>+driver</c></tag> <item> - <p>Together with the flags <c>ber_bin</c> and <c>optimize</c> - you choose to use a linked in driver for considerable faster - decode.</p> + <p>As of R15B this means the same as the <c>nif</c> option. Kept for + backwards compatability reasons.</p> + </item> + <tag><c>+nif</c></tag> + <item> + <p>Together with the flags <c>ber_bin</c> + and <c>optimize</c> you choose to use a nif for considerable + faster encode and decode. </p> </item> <tag><c>+asn1config</c></tag> <item> @@ -492,7 +497,7 @@ asn1ct:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> </row> <row> <cell align="left" valign="middle">BER</cell> - <cell align="left" valign="middle"><em>[ber_bin, optimize, driver]</em></cell> + <cell align="left" valign="middle"><em>[ber_bin, optimize, nif]</em></cell> <cell align="left" valign="middle">EAVF</cell> <cell align="left" valign="middle">iolist</cell> <cell align="left" valign="middle">iolist / binary</cell> @@ -557,7 +562,7 @@ asn1ct:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> </row> <row> <cell align="left" valign="middle">DER</cell> - <cell align="left" valign="middle"><em>[ber_bin, optimize, driver, der]</em></cell> + <cell align="left" valign="middle"><em>[ber_bin, optimize, nif, der]</em></cell> <cell align="left" valign="middle">EAVF</cell> <cell align="left" valign="middle">iolist</cell> <cell align="left" valign="middle">binary</cell> @@ -626,23 +631,24 @@ asn1ct:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> </table> <p> - The sole compile options <c>ber</c>, <c>ber_bin</c> and <c>per</c> - are kept for backwards compatibility and should not be used in - new code. + The compile options <c>ber</c>, <c>per</c> and + <c>driver</c> are kept for backwards compatibility and should not be + used in new code. The nif implementation which replaces the linked-in + driver has been shown to be about 5-15% faster. </p> <p> You are strongly recommended to use the appropriate alternative of the bold typed options. The <c>optimize</c> and - <c>driver</c> options does not affect the encode or decode + <c>nif</c> options does not affect the encode or decode result, just the time spent in run-time. When <c>ber_bin</c> and - <c>driver</c> or <c>per_bin, optimize</c> and <c>driver</c> is - combined the C-code driver is used in chosen parts of encode / + <c>nif</c> or <c>per_bin</c> and <c>optimize</c> is + combined the C-code nif is used in chosen parts of encode / decode procedure. </p> <table> <row> <cell align="left" valign="middle"><em>Compile options, allowed combinations</em></cell> - <cell align="left" valign="middle"><em>use of linked-in driver</em></cell> + <cell align="left" valign="middle"><em>use of nif</em></cell> </row> <row> <cell align="left" valign="middle">[ber]</cell> @@ -657,7 +663,7 @@ asn1ct:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> <cell align="left" valign="middle">no</cell> </row> <row> - <cell align="left" valign="middle"><em>[ber_bin, optimize, driver]</em></cell> + <cell align="left" valign="middle"><em>[ber_bin, optimize, nif]</em></cell> <cell align="left" valign="middle">yes</cell> </row> <row> @@ -690,12 +696,12 @@ asn1ct:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> <cell align="left" valign="middle">no</cell> </row> <row> - <cell align="left" valign="middle"><em>[ber_bin, optimize, driver, der]</em></cell> + <cell align="left" valign="middle"><em>[ber_bin, optimize, nif, der]</em></cell> <cell align="left" valign="middle">yes</cell> </row> - <tcaption>When the ASN1 linked-in driver is used.</tcaption> + <tcaption>When the ASN1 nif is used.</tcaption> </table> </section> @@ -712,14 +718,14 @@ asn1rt:decode('H323-MESSAGES','SomeChoiceType',Bytes). </pre> <pre> 'H323-MESSAGES':encode('SomeChoiceType',{call,"octetstring"}). 'H323-MESSAGES':decode('SomeChoiceType',Bytes). </pre> - <p>The asn1 linked-in driver is enabled in two occasions: encoding of + <p>The asn1 nif is enabled in two occasions: encoding of asn1 values when the asn1 spec is compiled with <c>per_bin</c> and <c>optimize</c> or decode of encoded asn1 values when the asn1 spec is - compiled with <c>ber_bin</c>, <c>optimize</c> and <c>driver</c>. In - those cases the driver will be loaded automatically at the first call + compiled with <c>ber_bin</c>, <c>optimize</c> and <c>nif</c>. In + those cases the nif will be loaded automatically at the first call to <c>encode</c>/<c>decode</c>. If one doesn't want the performance - overhead of the driver being loaded at the first call it is possible - to load the driver separately by <c>asn1rt:load_driver()</c>. </p> + overhead of the nif being loaded at the first call it is possible + to load the nif separately by loading the <c>asn1rt_nif</c> module.</p> <p>By invoking the function <c>info/0</c> in a generated module, one gets information about which compiler options were used.</p> </section> diff --git a/lib/asn1/doc/src/asn1ct.xml b/lib/asn1/doc/src/asn1ct.xml index 50458b4a9a..0b9ec3df7f 100644 --- a/lib/asn1/doc/src/asn1ct.xml +++ b/lib/asn1/doc/src/asn1ct.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2010</year> + <year>1997</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -52,7 +52,7 @@ <v>Options = [Option| OldOption]</v> <v>Option = ber_bin | per_bin | uper_bin | der | compact_bit_string | noobj | {n2n,EnumTypeName} |{outdir,Dir} | {i,IncludeDir} | optimize | - driver | asn1config | undec_rest | {inline,OutputName} | inline | + nif | asn1config | undec_rest | {inline,OutputName} | inline | {macro_name_prefix, Prefix} | {record_name_prefix, Prefix} | verbose | warnings_as_errors</v> <v>OldOption = ber | per</v> <v>Reason = term()</v> @@ -212,16 +212,21 @@ Binary = binary() <c>per_bin</c> or <c>ber_bin</c> option. It gives time optimized code generated and it uses another runtime module and - in the <c>per_bin</c> case a linked-in driver. The result + in the <c>per_bin</c> case a nif. The result in the <c>per_bin</c> case from an encode when compiled with this option will be a binary.</p> </item> <tag><c>driver</c></tag> <item> + <p>As of R15B this means the same as the <c>nif</c> option. Kept for + backwards compatability reasons.</p> + </item> + <tag><c>nif</c></tag> + <item> <p>Option valid together with <c>ber_bin</c> and <c>optimize</c> - options. It enables the use of a linked-in driver that gives - considerable faster decode. In <c>ber_bin</c> the driver is - enabled only by explicit use of the option <c>driver</c>.</p> + options. It enables the use of several nifs that gives faster + encode and decode. Nifs are only enabled by the explicit use of + the option <c>nif</c></p> </item> <tag><c>asn1config</c></tag> <item> @@ -264,7 +269,11 @@ Binary = binary() <c>.set.asn</c> are exported, unless a <c>{export,[atom()]}</c> or <c>{export_all,true}</c> option are provided. The list of atoms are names of chosen asn1 - specs from the <c>.set.asn</c> file.</p> + specs from the <c>.set.asn</c> file. </p> + <p>When used together with <c>nif</c> for <c>ber_bin</c>, the + asn1 nifs will be used if the <c>asn1rt_nif</c> module is + available. If it is not available, a slower erlang fallback + will be used.</p> </item> <tag><c>inline</c></tag> <item> @@ -347,18 +356,6 @@ Binary = binary() </desc> </func> <func> - <name>validate(Module,Type,Value) -> ok | {error,Reason}</name> - <fsummary>Validate an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = term()</v> - </type> - <desc> - <p>Validates that <c>Value</c> conforms to <c>Type</c> - from <c>Module</c>. <em>Not implemented in this version of the ASN.1 application.</em></p> - </desc> - </func> - <func> <name>value(Module ,Type) -> {ok,Value} | {error,Reason}</name> <fsummary>Create an ASN.1 value for test purposes.</fsummary> <type> diff --git a/lib/asn1/doc/src/asn1rt.xml b/lib/asn1/doc/src/asn1rt.xml index 1217a07e9b..0c3c257189 100644 --- a/lib/asn1/doc/src/asn1rt.xml +++ b/lib/asn1/doc/src/asn1rt.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1997</year><year>2009</year> + <year>1997</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -42,36 +42,6 @@ <funcs> <func> - <name>start() -> ok |{error,Reason}</name> - <fsummary>Starts the asn1 server.</fsummary> - <type> - <v>Reason = term()</v> - </type> - <desc> - <p>Starts the asn1 server that loads the drivers.</p> - <p>The server schedules a driver that is not blocked by - another caller. The driver is used by the asn1 application if - specs are compiled with options <c>[per_bin, optimize]</c> or - <c>[ber_bin, optimize, driver]</c>. The server will be started - automatically at encode/decode if it isn't done explicitly. If - encode/decode with driver is used in test or industrial code - it is a performance gain to start it explicitly to avoid the - one time load in run-time.</p> - </desc> - </func> - - <func> - <name>stop() -> ok |{error,Reason}</name> - <fsummary>Stops the asn1 server.</fsummary> - <type> - <v>Reason = term()</v> - </type> - <desc> - <p>Stops the asn1 server and unloads the drivers.</p> - </desc> - </func> - - <func> <name>decode(Module,Type,Bytes) -> {ok,Value}|{error,Reason}</name> <fsummary>Decode from bytes into an ASN.1 value.</fsummary> <type> @@ -126,35 +96,23 @@ <func> <name>load_driver() -> ok | {error,Reason}</name> - <fsummary>Loads the linked-in driver.</fsummary> + <fsummary>Loads the linked-in driver. (deprecated)</fsummary> <type> <v>Reason = term()</v> </type> <desc> - <p>This function loads the linked-in driver before the first call - to encode. If this function is not called the driver will be loaded - automatically at the first call to encode. If one doesn't want the - performance cost of a driver load when the application is running, - this function makes it possible to load the driver in an - initialization.</p> - <p>The driver is only used when encoding/decoding ASN.1 files that - were compiled with the options <c>per_bin</c> and <c>optimize</c>.</p> + <p>This function is obsolete and will be removed in R16A</p> </desc> </func> <func> <name>unload_driver() -> ok | {error,Reason}</name> - <fsummary>Unloads the linked-in driver.</fsummary> + <fsummary>Unloads the linked-in driver. (deprecated)</fsummary> <type> <v>Reason = term()</v> </type> <desc> - <p>This function unloads the linked-in driver. - When the driver has been loaded it remains in the environment until - it is unloaded. Normally the driver should remain loaded, it is - crucial for the performance of ASN.1 encoding. </p> - <p>The driver is only used when ASN.1 modules have been compiled - with the flags <c>per_bin</c> and <c>optimize</c>.</p> + <p>This function is obsolete and will be removed in R16A</p> </desc> </func> @@ -188,19 +146,6 @@ value, to a UTF8 encoded binary.</p> </desc> </func> - - <func> - <name>validate(Module,Type,Value) -> ok | {error,Reason}</name> - <fsummary>Validate an ASN.1 value.</fsummary> - <type> - <v>Module = Type = atom()</v> - <v>Value = term()</v> - </type> - <desc> - <p>Validates that <c>Value</c> conforms to <c>Type</c> - from <c>Module</c>. <em>Not implemented in this version of the ASN.1 application.</em></p> - </desc> - </func> </funcs> diff --git a/lib/asn1/src/Makefile b/lib/asn1/src/Makefile index 2733cde3f8..3a59773d93 100644 --- a/lib/asn1/src/Makefile +++ b/lib/asn1/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2009. All Rights Reserved. +# Copyright Ericsson AB 1997-2011. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -68,7 +68,7 @@ RT_MODULES= \ asn1rt_per_bin_rt2ct \ asn1rt_uper_bin \ asn1rt_check \ - asn1rt_driver_handler + asn1rt_nif # asn1_sup \ # asn1_app \ # asn1_server diff --git a/lib/asn1/src/asn1.app.src b/lib/asn1/src/asn1.app.src index abacb0a1e9..09144ba2f7 100644 --- a/lib/asn1/src/asn1.app.src +++ b/lib/asn1/src/asn1.app.src @@ -9,12 +9,11 @@ asn1rt_ber_bin, asn1rt_ber_bin_v2, asn1rt_check, - asn1rt_driver_handler + asn1rt_nif ]}, {registered, [ asn1_ns, - asn1db, - asn1_driver_owner + asn1db ]}, {env, []}, {applications, [kernel, stdlib]} diff --git a/lib/asn1/src/asn1_app.erl b/lib/asn1/src/asn1_app.erl index 2d3eed1743..9fff96e0bf 100644 --- a/lib/asn1/src/asn1_app.erl +++ b/lib/asn1/src/asn1_app.erl @@ -28,7 +28,7 @@ %% {error, Reason} %% start(_Type, _StartArgs) -> - asn1_sup:start_link(). + {ok, self()}. %% stop(State) %% diff --git a/lib/asn1/src/asn1_server.erl b/lib/asn1/src/asn1_server.erl deleted file mode 100644 index aeb59d8b0c..0000000000 --- a/lib/asn1/src/asn1_server.erl +++ /dev/null @@ -1,107 +0,0 @@ -%% ``The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved via the world wide web at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% 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$ -%% - -%% Purpose: Provide complete encode/and pre-decode of asn1. --module(asn1_server). - - - --behaviour(gen_server). - --export([start_link/0,client_port/0]). - -%% Internal exports, call-back functions. --export([init/1,handle_call/3,handle_cast/2,handle_info/2,code_change/3, - terminate/2]). - - -%% Macros --define(port_names, - { asn1_drv01, asn1_drv02, asn1_drv03, asn1_drv04, - asn1_drv05, asn1_drv06, asn1_drv07, asn1_drv08, - asn1_drv09, asn1_drv10, asn1_drv11, asn1_drv12, - asn1_drv13, asn1_drv14, asn1_drv15, asn1_drv16 }). -%%% -------------------------------------------------------- -%%% Interface Functions. -%%% -------------------------------------------------------- - -start_link() -> - gen_server:start_link({local, asn1_server}, asn1_server, [], []). - -init([]) -> - process_flag(trap_exit, true), - erl_ddll:start(), - PrivDir = code:priv_dir(asn1), - LibDir1 = filename:join([PrivDir, "lib"]), - case erl_ddll:load_driver(LibDir1, asn1_erl_drv) of - ok -> ok; - {error,_} -> - LibDir2 = - filename:join(LibDir1, - erlang:system_info(system_architecture)), - erl_ddll:load_driver(LibDir2, asn1_erl_drv) - end, - open_ports("asn1_erl_drv",size(?port_names)). - -open_ports(_,0) -> - {ok, []}; -open_ports(Cmd,N) -> - Port = open_port({spawn, Cmd}, []), - %% check that driver is loaded, linked and working - case catch port_control(Port, 0, []) of - {'EXIT', _} -> - {stop, nodriver}; - _ -> - register(element(N,?port_names), Port), - open_ports(Cmd,N-1) - end. - -client_port() -> - element(erlang:system_info(scheduler_id) rem size(?port_names) + 1, - ?port_names). - - -%%% -------------------------------------------------------- -%%% The call-back functions. -%%% -------------------------------------------------------- - -handle_call(_, _, State) -> - {noreply, State}. - -handle_cast(_, State) -> - {noreply, State}. - -handle_info({'EXIT', Pid, _Reason}, State) when is_pid(Pid) -> - {noreply, State}; - -handle_info({'EXIT', Port, Reason}, State) when is_port(Port) -> - {stop, {port_died, Reason}, State}; -handle_info(_, State) -> - {noreply, State}. - -code_change(_OldVsn, State, _Extra) -> - {ok, State}. - -terminate(_Reason, _State) -> - close_ports(size(?port_names)). - -close_ports(0) -> - ok; -close_ports(N) -> - element(N,?port_names) ! {self(), close}, %% almost same as port_close(Name) - close_ports(N-1). diff --git a/lib/asn1/src/asn1_sup.erl b/lib/asn1/src/asn1_sup.erl deleted file mode 100644 index a241dec6f4..0000000000 --- a/lib/asn1/src/asn1_sup.erl +++ /dev/null @@ -1,37 +0,0 @@ -%% ``The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved via the world wide web at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% 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$ -%% - -%% Purpose: Main supervisor in asn1 application. - --module(asn1_sup). - --behaviour(supervisor). - --export([start_link/0, init/1]). - -start_link() -> - supervisor:start_link({local, asn1_sup}, asn1_sup, []). - - -%% init([]) -%% Returns: {ok, {SupFlags, [ChildSpec]}} -%% -init([]) -> - Child = {asn1_server, {asn1_server, start_link, []}, - permanent, 2000, worker, [asn1_server]}, - {ok, {{one_for_all, 10, 3600}, [Child]}}. diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index e26fadd160..85bb5b2f28 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -47,6 +47,10 @@ -import(asn1ct_gen_ber_bin_v2,[encode_tag_val/3,decode_class/1]). +-ifndef(vsn). +-define(vsn,"0.0.1"). +-endif. + -define(unique_names,0). -define(dupl_uniquedefs,1). -define(dupl_equaldefs,2). @@ -81,6 +85,12 @@ compile(File) -> compile(File,[]). compile(File,Options) when is_list(Options) -> + case lists:member(driver, Options) of %% remove me in R16A! + true -> + io:format("Warning: driver option is obsolete and will be removed in R16A, use nif instead!"); + false -> + ok + end, Options1 = optimize_ber_bin(Options), Options2 = includes(File,Options1), Includes=[I||{i,I}<-Options2], @@ -1085,7 +1095,7 @@ get_runtime_mod(Options) -> ber_bin_v2 -> ["asn1rt_ber_bin_v2.erl"]; uper_bin -> ["asn1rt_uper_bin.erl"] end, - RtMod1++["asn1rt_check.erl","asn1rt_driver_handler.erl","asn1rt.erl"]. + RtMod1++["asn1rt_check.erl","asn1rt.erl"]. erl_compile(OutFile,Options) -> diff --git a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl index e3be914af4..243ff234a7 100644 --- a/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_constructed_ber_bin_v2.erl @@ -877,13 +877,13 @@ gen_dec_choice(Erules,TopType, _ChTag, CompList, Ext) -> emit([indent(9),"exit({error,{asn1,{invalid_choice_tag,", {curr,else},"}}})",nl]); _ -> - emit([indent(9),"{asn1_ExtAlt, ?RT_BER:encode(",{curr,else},")}",nl]) + emit([indent(9),"{asn1_ExtAlt, ?RT_BER:encode(",{curr,else}, + asn1ct_gen:nif_parameter(),")}",nl]) end, emit([indent(3),"end",nl]), asn1ct_name:new(tag), asn1ct_name:new(else). - gen_dec_choice_cases(_Erules,_TopType, []) -> ok; gen_dec_choice_cases(Erules,TopType, [H|T]) -> @@ -1227,7 +1227,7 @@ gen_dec_call({typefield,_},_,_,_Cname,Type,BytesVar,Tag,_,_,false,_) -> emit([nl,indent(6),"begin",nl]), % emit([indent(9),{curr,opendec}," = ?RT_BER:decode_open_type(", emit([indent(9),{curr,tmptlv}," = ?RT_BER:decode_open_type(", - BytesVar,",",{asis,Tag},"),",nl]), + BytesVar,",",{asis,Tag},asn1ct_gen:nif_parameter(),"),",nl]), % emit([indent(9),"{",{curr,tmptlv},",_} = ?RT_BER:decode(", % {curr,opendec},"),",nl]), @@ -1242,7 +1242,8 @@ gen_dec_call({typefield,_},_,_,_Cname,Type,BytesVar,Tag,_,_,false,_) -> emit([indent(9),"end",nl,indent(6),"end",nl]), []; gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag},")"]), + emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag}, + asn1ct_gen:nif_parameter(),")"]), RefedFieldName = % asn1ct_gen:get_constraint(Type#type.constraint, % tableconstraint_info), @@ -1250,7 +1251,8 @@ gen_dec_call({typefield,_},_,_,Cname,Type,BytesVar,Tag,_,_,_DecObjInf,OptOrMandC [{Cname,RefedFieldName,asn1ct_gen:mk_var(asn1ct_name:curr(term)), asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; gen_dec_call({objectfield,PrimFieldName,PFNList},_,_,Cname,_,BytesVar,Tag,_,_,_,OptOrMandComp) -> - emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag},")"]), + emit(["?RT_BER:decode_open_type(",BytesVar,",",{asis,Tag}, + asn1ct_gen:nif_parameter(),")"]), [{Cname,{PrimFieldName,PFNList},asn1ct_gen:mk_var(asn1ct_name:curr(term)), asn1ct_gen:mk_var(asn1ct_name:curr(tmpterm)),Tag,OptOrMandComp}]; gen_dec_call(InnerType,Erules,TopType,Cname,Type,BytesVar,Tag,PrimOptOrMand, diff --git a/lib/asn1/src/asn1ct_constructed_per.erl b/lib/asn1/src/asn1ct_constructed_per.erl index c1b6aa5713..e07680f10b 100644 --- a/lib/asn1/src/asn1ct_constructed_per.erl +++ b/lib/asn1/src/asn1ct_constructed_per.erl @@ -73,16 +73,23 @@ gen_encode_constructed(Erule,Typename,D) when is_record(D,type) -> _ -> ok end, - case {Optionals = optionals(to_textual_order(CompList)),CompList} of - {[],EmptyCL} when EmptyCL == {[],[],[]};EmptyCL == {[],[]};EmptyCL == [] -> + case {Optionals = optionals(to_textual_order(CompList)),CompList, + is_optimized(Erule)} of + {[],EmptyCL,_} when EmptyCL == {[],[],[]};EmptyCL == {[],[]};EmptyCL == [] -> emit(["%%Variable setting just to eliminate ", "compiler warning for unused vars!",nl, "_Val = ",{curr,val},",",nl]); - {[],_} -> + {[],_,_} -> emit([{next,val}," = ?RT_PER:list_to_record("]), emit(["'",asn1ct_gen:list2rname(Typename),"'"]), emit([", ",{curr,val},"),",nl]); - _ -> + {_,_,true} -> + gen_fixoptionals(Optionals), + FixOpts = param_map(fun(Var) -> + {var,Var} + end,asn1ct_name:all(fixopt)), + emit({"{",{next,val},",Opt} = {",{curr,val},",[",FixOpts,"]},",nl}); + {_,_,false} -> Fixoptcall = ",Opt} = ?RT_PER:fixoptionals(", emit({"{",{next,val},Fixoptcall, {asis,Optionals},",",length(Optionals), @@ -439,9 +446,7 @@ gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) -> _-> "" end, - emit({nl,indent(3),"?RT_PER:encode_length(", - {asis,SizeConstraint}, - ",length(Val)),",nl}), + gen_encode_length(SizeConstraint, is_optimized(Erule)), emit({indent(3),"'enc_",asn1ct_gen:list2name(Typename), "_components'(Val",ObjFun,", [])"}), emit({nl,"].",nl}), @@ -453,6 +458,42 @@ gen_encode_sof(Erule,Typename,SeqOrSetOf,D) when is_record(D,type) -> end, gen_encode_sof_components(Erule,Typename,SeqOrSetOf,NewComponentType). + +%% Logic copied from asn1_per_bin_rt2ct:encode_constrained_number +gen_encode_length({Lb,Ub},true) when Ub =< 65535, Lb >= 0 -> + Range = Ub - Lb + 1, + V2 = ["(length(Val) - ",Lb,")"], + Encode = if + Range == 1 -> + "[]"; + Range == 2 -> + {"[",V2,"]"}; + Range =< 4 -> + {"[10,2,",V2,"]"}; + Range =< 8 -> + {"[10,3,",V2,"]"}; + Range =< 16 -> + {"[10,4,",V2,"]"}; + Range =< 32 -> + {"[10,5,",V2,"]"}; + Range =< 64 -> + {"[10,6,",V2,"]"}; + Range =< 128 -> + {"[10,7,",V2,"]"}; + Range =< 255 -> + {"[10,8,",V2,"]"}; + Range =< 256 -> + {"[20,1,",V2,"]"}; + Range =< 65536 -> + {"[20,2,<<",V2,":16>>]"}; + true -> + {"?RT_PER:encode_length(",{asis,{Lb,Ub}},",length(Val))"} + end, + emit({nl,Encode,",",nl}); +gen_encode_length(SizeConstraint,_) -> + emit({nl,indent(3),"?RT_PER:encode_length(", + {asis,SizeConstraint},",length(Val)),",nl}). + gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> asn1ct_name:start(), {_SeqOrSetOf,ComponentType} = D#type.def, @@ -469,7 +510,8 @@ gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> _ -> "" end, - emit({nl,"{Num,Bytes1} = ?RT_PER:decode_length(Bytes,",{asis,SizeConstraint},"),",nl}), + gen_decode_length(SizeConstraint, + is_optimized(Erules)), emit({"'dec_",asn1ct_gen:list2name(Typename), "_components'(Num, Bytes1, telltype",ObjFun,", []).",nl}), NewComponentType = @@ -480,6 +522,41 @@ gen_decode_sof(Erules,Typename,SeqOrSetOf,D) when is_record(D,type) -> end, gen_decode_sof_components(Erules,Typename,SeqOrSetOf,NewComponentType). +%% Logic copied from asn1_per_bin_rt2ct:decode_constrained_number +gen_decode_length({Lb,Ub},true) when Ub =< 65535, Lb >= 0 -> + Range = Ub - Lb + 1, + Call = if + Range == 1 -> + "{0,Bytes}"; + Range == 2 -> + "?RT_PER:getbits(Bytes,1)"; + Range =< 4 -> + "?RT_PER:getbits(Bytes,2)"; + Range =< 8 -> + "?RT_PER:getbits(Bytes,3)"; + Range =< 16 -> + "?RT_PER:getbits(Bytes,4)"; + Range =< 32 -> + "?RT_PER:getbits(Bytes,5)"; + Range =< 64 -> + "?RT_PER:getbits(Bytes,6)"; + Range =< 128 -> + "?RT_PER:getbits(Bytes,7)"; + Range =< 255 -> + "?RT_PER:getbits(Bytes,8)"; + Range =< 256 -> + "?RT_PER:getoctets(Bytes,1)"; + Range =< 65536 -> + "?RT_PER:getoctets(Bytes,2)"; + true -> + ["exit({not_supported,{integer_range,",Range,"}}"] + end, + emit({nl,"{Val,Remain} = ",Call,",",nl}), + emit({nl,"{Num,Bytes1} = {Val+",Lb,",Remain},",nl}); +gen_decode_length(SizeConstraint,_) -> + emit({nl,"{Num,Bytes1} = ?RT_PER:decode_length(Bytes,", + {asis,SizeConstraint},"),",nl}). + gen_encode_sof_components(Erule,Typename,SeqOrSetOf,Cont) -> {ObjFun,ObjFun_Var} = case Cont#type.tablecinf of @@ -636,6 +713,27 @@ gen_dec_extension_value(_) -> emit({"{Ext,",{next,bytes},"} = ?RT_PER:getext(",{curr,bytes},")"}), asn1ct_name:new(bytes). +gen_fixoptionals([{Pos,Def}|R]) -> + asn1ct_name:new(fixopt), + emit({{curr,fixopt}," = case element(",{asis,Pos},",",{curr,val},") of",nl, + "asn1_DEFAULT -> 0;",nl, + {asis,Def}," -> 0;",nl, + "_ -> 1",nl, + "end,",nl}), + gen_fixoptionals(R); +gen_fixoptionals([Pos|R]) -> + gen_fixoptionals([{Pos,asn1_NOVALUE}|R]); +gen_fixoptionals([]) -> + ok. + + +param_map(Fun, [H]) -> + [Fun(H)]; +param_map(Fun, [H|T]) -> + [Fun(H),","|param_map(Fun,T)]. + + + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Produce a list with positions (in the Value record) where %% there are optional components, start with 2 because first element @@ -922,7 +1020,7 @@ gen_enc_line(Erule,TopType,Cname,Type,Element, _Pos,DynamicEnc,Ext) -> end, case Ext of {ext,_Ep2,_} -> - emit(["))"]); + emit("))"); _ -> true end. gen_dec_components_call(Erule,TopType,{Root1,ExtList,Root2},MaybeComma,DecInfObj,Ext,NumberOfOptionals) -> diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index e49829d82f..0f8833f716 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -47,6 +47,7 @@ un_hyphen_var/1]). -export([gen_encode_constructed/4, gen_decode_constructed/4]). +-export([nif_parameter/0]). %% pgen(Outfile, Erules, Module, TypeOrVal, Options) %% Generate Erlang module (.erl) and (.hrl) file corresponding to an ASN.1 module @@ -938,13 +939,13 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> NoFinalPadding = lists:member(no_final_padding,get(encoding_options)), Call = case Erules of per -> "?RT_PER:complete(encode_disp(Type,Data))"; - per_bin -> "?RT_PER:complete(encode_disp(Type,Data))"; + per_bin -> ["?RT_PER:complete(encode_disp(Type,Data))"]; ber -> "encode_disp(Type,Data)"; ber_bin -> "encode_disp(Type,Data)"; ber_bin_v2 -> "encode_disp(Type,Data)"; uper_bin when NoFinalPadding == true -> "?RT_PER:complete_NFP(encode_disp(Type,Data))"; - uper_bin -> "?RT_PER:complete(encode_disp(Type,Data))" + uper_bin -> ["?RT_PER:complete(encode_disp(Type,Data))"] end, EncWrap = case Erules of ber -> "wrap_encode(Bytes)"; @@ -974,7 +975,7 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> % case Erules of % ber_bin_v2 -> % emit(["decode(Type,Data0) ->",nl]), -% emit(["{Data,_RestBin} = ?RT_BER:decode(Data0",driver_parameter(),"),",nl]); +% emit(["{Data,_RestBin} = ?RT_BER:decode(Data0",nif_parameter(),"),",nl]); % _ -> % emit(["decode(Type,Data) ->",nl]) % end, @@ -991,10 +992,10 @@ pgen_dispatcher(Erules,_Module,{Types,_Values,_,_,_Objects,_ObjectSets}) -> {ber_bin_v2,false} -> io_lib:format("~s~s~s~n", ["element(1,?RT_BER:decode(Data", - driver_parameter(),"))"]); + nif_parameter(),"))"]); {ber_bin_v2,true} -> emit(["{Data,Rest} = ?RT_BER:decode(Data0", - driver_parameter(),"),",nl]), + nif_parameter(),"),",nl]), "Data"; _ -> "Data" @@ -1130,13 +1131,8 @@ gen_decode_partial_incomplete(Erule) when Erule == ber;Erule==ber_bin; "Data) of",nl]), EmitCaseClauses(), emit(["decode_part(Type,Data0) ->",nl]), - Driver = - case lists:member(driver,get(encoding_options)) of - true -> - ",driver"; - _ -> "" - end, - emit([" case catch decode_inc_disp(Type,element(1,?RT_BER:decode(Data0",Driver,"))) of",nl]), + emit([" case catch decode_inc_disp(Type,element(1," + "?RT_BER:decode(Data0",nif_parameter(),"))) of",nl]), % " {Data,_RestBin} = ?RT_BER:decode(Data0),",nl, % " case catch decode_inc_disp(Type,Data) of",nl]), EmitCaseClauses(); @@ -1179,12 +1175,12 @@ gen_partial_inc_dispatcher([],_) -> emit(["decode_partial_inc_disp(Type,_Data) ->",nl, " exit({error,{asn1,{undefined_type,Type}}}).",nl]). -driver_parameter() -> +nif_parameter() -> Options = get(encoding_options), - case lists:member(driver,Options) of - true -> - ",driver"; - _ -> "" + case {lists:member(driver,Options),lists:member(nif,Options)} of + {true,_} -> ",nif"; + {_,true} -> ",nif"; + _ -> "" end. gen_wrapper() -> @@ -1525,8 +1521,9 @@ gen_head(Erules,Mod,Hrl) -> emit({"-module('",Mod,"').",nl}), put(currmod,Mod), %emit({"-compile(export_all).",nl}), - case Hrl of - 0 -> true; + case {Hrl,lists:member(inline,get(encoding_options))} of + {0,_} -> true; + {_,true} -> true; _ -> emit({"-include(\"",Mod,".hrl\").",nl}) end, diff --git a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl index 9ec458e351..781271bae7 100644 --- a/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl +++ b/lib/asn1/src/asn1ct_gen_ber_bin_v2.erl @@ -416,7 +416,7 @@ gen_decode_selected(Erules,Type,FuncName) -> end, emit([" case ?RT_BER:decode_selective(",{asis,Pattern},",Bin) of",nl, " {ok,Bin2} when is_binary(Bin2) ->",nl, - " {Tlv,_} = ?RT_BER:decode(Bin2),",nl]), + " {Tlv,_} = ?RT_BER:decode(Bin2",asn1ct_gen:nif_parameter(),"),",nl]), emit("{ok,"), gen_decode_selected_type(Erules,Type), emit(["};",nl," Err -> exit({error,{selctive_decode,Err}})",nl, @@ -708,7 +708,7 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> 'ASN1_OPEN_TYPE' -> emit(["?RT_BER:decode_open_type_as_binary(", BytesVar,","]), - add_func({decode_open_type_as_binary,2}); + add_func({decode_open_type_as_binary,3}); #'ObjectClassFieldType'{} -> case asn1ct_gen:get_inner(Att#type.def) of {fixedtypevaluefield,_,InnerType} -> @@ -716,7 +716,7 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> 'ASN1_OPEN_TYPE' -> emit(["?RT_BER:decode_open_type_as_binary(", BytesVar,","]), - add_func({decode_open_type_as_binary,2}); + add_func({decode_open_type_as_binary,3}); Other -> exit({'can not decode' ,Other}) end; @@ -728,13 +728,13 @@ gen_dec_prim(Erules,Att,BytesVar,DoTag,TagIn,Form,OptOrMand) -> {_,#'ObjectClassFieldType'{}} -> case asn1ct_gen:get_inner(Att#type.def) of 'ASN1_OPEN_TYPE' -> - emit([{asis,DoTag},")"]); + emit([{asis,DoTag},asn1ct_gen:nif_parameter(),")"]); _ -> ok end; {{string,TagStr},'ASN1_OPEN_TYPE'} -> - emit([TagStr,")"]); + emit([TagStr,asn1ct_gen:nif_parameter(),")"]); {_,'ASN1_OPEN_TYPE'} -> - emit([{asis,DoTag},")"]); + emit([{asis,DoTag},asn1ct_gen:nif_parameter(),")"]); {{string,TagStr},_} -> emit([TagStr,")"]); _ when is_list(DoTag) -> @@ -1064,7 +1064,7 @@ emit_tlv_format_function() -> end. emit_tlv_format_function1() -> emit(["tlv_format(Bytes) when is_binary(Bytes) ->",nl, - " {Tlv,_}=?RT_BER:decode(Bytes),",nl, + " {Tlv,_}=?RT_BER:decode(Bytes",asn1ct_gen:nif_parameter(),"),",nl, " Tlv;",nl, "tlv_format(Bytes) ->",nl, " Bytes.",nl]). @@ -1502,13 +1502,14 @@ gen_objset_dec(Erules,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, _ClFields,_NthObj) -> emit(["'getdec_",ObjSetName,"'(_, _) ->",nl]), emit([indent(2),"fun(_,Bytes, _RestPrimFieldName) ->",nl]), + case Erules of ber_bin_v2 -> emit([indent(4),"case Bytes of",nl, indent(6),"Bin when is_binary(Bin) -> ",nl, indent(8),"Bin;",nl, indent(6),"_ ->",nl, - indent(8),"?RT_BER:encode(Bytes)",nl, + indent(8),"?RT_BER:encode(Bytes",driver_parameter(),")",nl, indent(4),"end",nl]); _ -> emit([indent(6),"Len = case Bytes of",nl,indent(9), @@ -1521,6 +1522,14 @@ gen_objset_dec(Erules,ObjSetName,_UniqueName,['EXTENSIONMARK'],_ClName, gen_objset_dec(_,_,_,[],_,_,_) -> ok. +driver_parameter() -> + Options = get(encoding_options), + case {lists:member(driver,Options),lists:member(nif,Options)} of + {true,_} -> ",nif"; + {_,true} -> ",nif"; + _ -> ",erlang" + end. + emit_default_getdec(ObjSetName,UniqueName) -> emit(["'getdec_",ObjSetName,"'(",{asis,UniqueName},", ErrV) ->",nl]), emit([indent(2), "fun(C,V,_) -> exit({{component,C},{value,V},{unique_name_and_value,",{asis,UniqueName},", ErrV}}) end"]). diff --git a/lib/asn1/src/asn1ct_gen_per.erl b/lib/asn1/src/asn1ct_gen_per.erl index 8313cf1b60..b90a0adf81 100644 --- a/lib/asn1/src/asn1ct_gen_per.erl +++ b/lib/asn1/src/asn1ct_gen_per.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -238,7 +238,8 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); [#type{def=#'Externaltypereference'{type=Tname}}] -> io_lib:format( - "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); + "?RT_PER:complete(enc_~s(~s))", + [Tname,Value]); _ -> Value end, emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", diff --git a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl index 4f4fcfafc3..1a0a0e211d 100644 --- a/lib/asn1/src/asn1ct_gen_per_rt2ct.erl +++ b/lib/asn1/src/asn1ct_gen_per_rt2ct.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -230,7 +230,8 @@ gen_encode_prim(Erules,D,DoTag,Value) when is_record(D,type) -> "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); [#type{def=#'Externaltypereference'{type=Tname}}] -> io_lib:format( - "?RT_PER:complete(enc_~s(~s))",[Tname,Value]); + "?RT_PER:complete(enc_~s(~s))", + [Tname,Value]); _ -> Value end, emit(["?RT_PER:encode_open_type(", {asis,Constraint}, ",", diff --git a/lib/asn1/src/asn1rt.erl b/lib/asn1/src/asn1rt.erl index 9ef68efab5..d18f81346a 100644 --- a/lib/asn1/src/asn1rt.erl +++ b/lib/asn1/src/asn1rt.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2009. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -21,12 +21,12 @@ %% Runtime functions for ASN.1 (i.e encode, decode) --include("asn1_records.hrl"). - -export([encode/2,encode/3,decode/3,load_driver/0,unload_driver/0,info/1]). -export([utf8_binary_to_list/1,utf8_list_to_binary/1]). +-deprecated([load_driver/0,unload_driver/0]). + encode(Module,{Type,Term}) -> encode(Module,Type,Term). @@ -46,38 +46,12 @@ decode(Module,Type,Bytes) -> Result end. -%% asn1-1.6.8.1 -%% load_driver() -> -%% asn1rt_driver_handler:load_driver(), -%% receive -%% driver_ready -> -%% ok; -%% Err={error,_Reason} -> -%% Err; -%% Error -> -%% {error,Error} -%% end. - -%% asn1-1.6.9 - load_driver() -> - case catch asn1rt_driver_handler:load_driver() of - ok -> - ok; - {error,{already_started,asn1}} -> - ok; - Err -> - {error,Err} - end. - +%% Remove in R16A +load_driver() -> + ok. unload_driver() -> - case catch asn1rt_driver_handler:unload_driver() of - ok -> - ok; - Error -> - {error,Error} - end. - + ok. info(Module) -> case catch apply(Module,info,[]) of diff --git a/lib/asn1/src/asn1rt_ber_bin_v2.erl b/lib/asn1/src/asn1rt_ber_bin_v2.erl index a3bb570282..17e66f77c9 100644 --- a/lib/asn1/src/asn1rt_ber_bin_v2.erl +++ b/lib/asn1/src/asn1rt_ber_bin_v2.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -21,7 +21,7 @@ %% encoding / decoding of BER --export([decode/1, decode/2, match_tags/2, encode/1]). +-export([decode/1, decode/2, match_tags/2, encode/1, encode/2]). -export([fixoptionals/2, cindex/3, list_to_record/2, encode_tag_val/1, @@ -49,11 +49,13 @@ decode_tag_and_length/1]). -export([encode_open_type/1,encode_open_type/2, - decode_open_type/2,decode_open_type_as_binary/2]). + decode_open_type/2,decode_open_type/3, + decode_open_type_as_binary/2, + decode_open_type_as_binary/3]). -export([decode_primitive_incomplete/2,decode_selective/2]). - --include("asn1_records.hrl"). + +-export([is_nif_loadable/0]). % the encoding of class of tag bits 8 and 7 -define(UNIVERSAL, 0). @@ -125,15 +127,28 @@ % encode(Tlv) -> % encode_constructed(Tlv). -encode([Tlv]) -> - encode(Tlv); -encode({TlvTag,TlvVal}) when is_list(TlvVal) -> +encode(Tlv) -> + encode(Tlv,erlang). + +encode(Tlv,_) when is_binary(Tlv) -> + Tlv; +encode([Tlv],Method) -> + encode(Tlv,Method); +encode(Tlv, nif) -> + case is_nif_loadable() of + true -> + asn1rt_nif:encode_ber_tlv(Tlv); + false -> + encode_erl(Tlv) + end; +encode(Tlv, _) -> + encode_erl(Tlv). + +encode_erl({TlvTag,TlvVal}) when is_list(TlvVal) -> %% constructed form of value encode_tlv(TlvTag,TlvVal,?CONSTRUCTED); -encode({TlvTag,TlvVal}) -> - encode_tlv(TlvTag,TlvVal,?PRIMITIVE); -encode(Bin) when is_binary(Bin) -> - Bin. +encode_erl({TlvTag,TlvVal}) -> + encode_tlv(TlvTag,TlvVal,?PRIMITIVE). encode_tlv(TlvTag,TlvVal,Form) -> Tag = encode_tlv_tag(TlvTag,Form), @@ -152,70 +167,61 @@ encode_tlv_val(Bin) -> {Bin,size(Bin)}. encode_tlv_list([Tlv|Tlvs],Acc) -> - EncTlv = encode(Tlv), + EncTlv = encode_erl(Tlv), encode_tlv_list(Tlvs,[EncTlv|Acc]); encode_tlv_list([],Acc) -> Bin=list_to_binary(lists:reverse(Acc)), {Bin,size(Bin)}. -%% asn1-1.6.8.1 -%% decode(B,driver) -> -%% case catch port_control(asn1_driver_port,2,B) of -%% Bin when is_binary(Bin) -> -%% binary_to_term(Bin); -%% List when is_list(List) -> handle_error(List,B); -%% {'EXIT',{badarg,Reason}} -> -%% asn1rt_driver_handler:load_driver(), -%% receive -%% driver_ready -> -%% case catch port_control(asn1_driver_port,2,B) of -%% Bin2 when is_binary(Bin2) -> binary_to_term(Bin2); -%% List when is_list(List) -> handle_error(List,B); -%% Error -> exit(Error) -%% end; -%% {error,Error} -> % error when loading driver -%% %% the driver could not be loaded -%% exit(Error); -%% Error={port_error,Reason} -> -%% exit(Error) -%% end; -%% {'EXIT',Reason} -> -%% exit(Reason) -%% end. - -%% asn1-1.6.9 -decode(B,driver) -> - case catch control(?TLV_DECODE,B) of - Bin when is_binary(Bin) -> - binary_to_term(Bin); - List when is_list(List) -> handle_error(List,B); - {'EXIT',{badarg,_Reason}} -> - case asn1rt:load_driver() of - ok -> - case control(?TLV_DECODE,B) of - Bin when is_binary(Bin) -> binary_to_term(Bin); - List when is_list(List) -> handle_error(List,B) - end; - Err -> - Err - end - end. +decode(B) -> + decode(B, erlang). +%% asn1-1.7 +decode(B, nif) -> + case is_nif_loadable() of + true -> + case asn1rt_nif:decode_ber_tlv(B) of + {error, Reason} -> handle_error(Reason, B); + Else -> Else + end; + false -> + decode(B) + end; +decode(B,erlang) when is_binary(B) -> + decode_primitive(B); +decode(Tlv,erlang) -> + {Tlv,<<>>}. + +%% Have to check this since asn1 is not guaranteed to be available +is_nif_loadable() -> + case application:get_env(asn1, nif_loadable) of + {ok,R} -> + R; + undefined -> + case catch code:load_file(asn1rt_nif) of + {module, asn1rt_nif} -> + application:set_env(asn1, nif_loadable, true), + true; + _Else -> + application:set_env(asn1, nif_loadable, false), + false + end + end. handle_error([],_)-> exit({error,{asn1,{"memory allocation problem"}}}); -handle_error([$1|_],L) -> % error in driver +handle_error({$1,_},L) -> % error in nif exit({error,{asn1,L}}); -handle_error([$2|T],L) -> % error in driver due to wrong tag +handle_error({$2,T},L) -> % error in nif due to wrong tag exit({error,{asn1,{"bad tag after byte:",error_pos(T),L}}}); -handle_error([$3|T],L) -> % error in driver due to length error +handle_error({$3,T},L) -> % error in driver due to length error exit({error,{asn1,{"bad length field after byte:", error_pos(T),L}}}); -handle_error([$4|T],L) -> % error in driver due to indefinite length error +handle_error({$4,T},L) -> % error in driver due to indefinite length error exit({error,{asn1, {"indefinite length without end bytes after byte:", error_pos(T),L}}}); -handle_error([$5|T],L) -> % error in driver due to indefinite length error +handle_error({$5,T},L) -> % error in driver due to indefinite length error exit({error,{asn1,{"bad encoded value after byte:", error_pos(T),L}}}); handle_error(ErrL,L) -> @@ -228,16 +234,6 @@ error_pos([B])-> error_pos([B|Bs]) -> BS = 8 * length(Bs), B bsl BS + error_pos(Bs). -%% asn1-1.6.9 -control(Cmd, Data) -> - Port = asn1rt_driver_handler:client_port(), - erlang:port_control(Port, Cmd, Data). - -decode(Bin) when is_binary(Bin) -> - decode_primitive(Bin); -decode(Tlv) -> % assume it is a tlv - {Tlv,<<>>}. - decode_primitive(Bin) -> {Form,TagNo,V,Rest} = decode_tag_and_length(Bin), @@ -796,20 +792,24 @@ encode_open_type(Val,Tag) -> %% Value = binary with decoded data (which must be decoded again as some type) %% decode_open_type(Tlv, TagIn) -> + decode_open_type(Tlv, TagIn, erlang). +decode_open_type(Tlv, TagIn, Method) -> case match_tags(Tlv,TagIn) of Bin when is_binary(Bin) -> - {InnerTlv,_} = decode(Bin), + {InnerTlv,_} = decode(Bin,Method), InnerTlv; TlvBytes -> TlvBytes end. -decode_open_type_as_binary(Tlv,TagIn)-> +decode_open_type_as_binary(Tlv, TagIn) -> + decode_open_type_as_binary(Tlv, TagIn, erlang). +decode_open_type_as_binary(Tlv,TagIn, Method)-> case match_tags(Tlv,TagIn) of V when is_binary(V) -> V; - [Tlv2] -> encode(Tlv2); - Tlv2 -> encode(Tlv2) + [Tlv2] -> encode(Tlv2, Method); + Tlv2 -> encode(Tlv2, Method) end. %%=============================================================================== @@ -1056,7 +1056,7 @@ encode_real(C,Val, TagIn) when is_tuple(Val); is_list(Val) -> encode_real(C,Val) -> - ?RT_COMMON:encode_real(C,Val). + asn1rt_ber_bin:encode_real(C,Val). %%============================================================================ @@ -1081,7 +1081,7 @@ decode_real_notag(Buffer) -> {_T,_V} -> exit({error,{asn1,{real_not_in_primitive_form,Buffer}}}) end, - {Val,_Rest,Len} = ?RT_COMMON:decode_real(Buffer,Len), + {Val,_Rest,Len} = asn1rt_ber_bin:decode_real(Buffer,Len), Val. %% exit({error,{asn1, {unimplemented,real}}}). %% decode_real2(Buffer, Form, size(Buffer)). @@ -1577,14 +1577,12 @@ e_object_identifier(V) when is_tuple(V) -> e_object_identifier([E1, E2 | Tail]) -> Head = 40*E1 + E2, % wow! {H,Lh} = mk_object_val(Head), - {R,Lr} = enc_obj_id_tail(Tail, [], 0), + {R,Lr} = lists:mapfoldl(fun enc_obj_id_tail/2,0,Tail), {[H|R], Lh+Lr}. -enc_obj_id_tail([], Ack, Len) -> - {lists:reverse(Ack), Len}; -enc_obj_id_tail([H|T], Ack, Len) -> +enc_obj_id_tail(H, Len) -> {B, L} = mk_object_val(H), - enc_obj_id_tail(T, [B|Ack], Len+L). + {B,Len+L}. %%%%%%%%%%% diff --git a/lib/asn1/src/asn1rt_check.erl b/lib/asn1/src/asn1rt_check.erl index 24a2a3802d..d9856901b8 100644 --- a/lib/asn1/src/asn1rt_check.erl +++ b/lib/asn1/src/asn1rt_check.erl @@ -19,8 +19,6 @@ %% -module(asn1rt_check). --include("asn1_records.hrl"). - -export([check_bool/2, check_int/3, check_bitstring/3, diff --git a/lib/asn1/src/asn1rt_driver_handler.erl b/lib/asn1/src/asn1rt_driver_handler.erl deleted file mode 100644 index 146d0043f9..0000000000 --- a/lib/asn1/src/asn1rt_driver_handler.erl +++ /dev/null @@ -1,144 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% -%% - --module(asn1rt_driver_handler). - --include("asn1_records.hrl"). - --export([load_driver/0,unload_driver/0,client_port/0]). - -%% Internal exports --export([init/2]). - -%% Macros --define(port_names, - { asn1_drv01, asn1_drv02, asn1_drv03, asn1_drv04, - asn1_drv05, asn1_drv06, asn1_drv07, asn1_drv08, - asn1_drv09, asn1_drv10, asn1_drv11, asn1_drv12, - asn1_drv13, asn1_drv14, asn1_drv15, asn1_drv16 }). - -%%% -------------------------------------------------------- -%%% Interface Functions. -%%% -------------------------------------------------------- -load_driver() -> - load_driver(noreason). - -load_driver(Reason) -> - Ref = make_ref(), - case whereis(asn1_driver_owner) of % to prevent unnecessary spawn - Pid when is_pid(Pid) -> - asn1_driver_owner ! {self(),Ref,are_you_ready}, - receive - {Ref,driver_ready} -> - ok - after 10000 -> - {error,{timeout,waiting_for_drivers}} - end; - _ -> - {_,Mref} = spawn_monitor(asn1rt_driver_handler, init, [self(),Ref]), - receive - {'DOWN', Mref, _, _, NewReason} -> - case NewReason of - Reason -> {error,Reason}; - _ -> load_driver(NewReason) - end; - {Ref,driver_ready} -> - erlang:demonitor(Mref), - ok; - {Ref,Error = {error,_Reason}} -> - erlang:demonitor(Mref), - Error - after 10000 -> %% 10 seconds - {error,{timeout,waiting_for_drivers}} - end - end. - -init(FromPid,FromRef) -> - case catch register(asn1_driver_owner,self()) of - true -> true; - _Other -> exit(normal) - end, - Dir = filename:join([code:priv_dir(asn1),"lib"]), - case catch erl_ddll:load_driver(Dir,asn1_erl_drv) of - ok -> - Result = open_named_ports(), - catch (FromPid ! {FromRef,Result}), - loop(Result); - {error,Err} -> % if erl_ddll:load_driver fails - ForErr = erl_ddll:format_error(Err), - OSDir = filename:join(Dir,erlang:system_info(system_architecture)), - case catch erl_ddll:load_driver(OSDir,asn1_erl_drv) of - ok -> - Result = open_named_ports(), - catch (FromPid ! {FromRef,Result}), - loop(Result); - {error,Err2} -> -% catch (FromPid ! {FromRef,Error}) - ForErr2 = erl_ddll:format_error(Err2), - catch (FromPid ! {FromRef,{error,{{Dir,ForErr},{OSDir,ForErr2}}}}) - end - end. - - -open_named_ports() -> - open_named_ports(size(?port_names)). - -open_named_ports(0) -> - driver_ready; -open_named_ports(N) -> - case catch open_port({spawn,"asn1_erl_drv"},[]) of - {'EXIT',Reason} -> - {error,{port_error,Reason}}; - Port -> - register(element(N,?port_names),Port), - open_named_ports(N-1) - end. - -loop(Result) -> - receive - {_FromPid,_FromRef,unload} -> - close_ports(size(?port_names)), - erl_ddll:unload_driver(asn1_erl_drv), - ok; - {FromPid,FromRef,are_you_ready} -> - catch (FromPid ! {FromRef,driver_ready}), - loop(Result); - _ -> - loop(Result) - end. - -unload_driver() -> - case whereis(asn1_driver_owner) of - Pid when is_pid(Pid) -> - Pid ! {self(),make_ref(),unload}, - ok; - _ -> - ok - end. - -close_ports(0) -> - ok; -close_ports(N) -> - element(N,?port_names) ! {self(), close}, %% almost same as port_close(Name) - close_ports(N-1). - -client_port() -> - element(erlang:system_info(scheduler_id) rem size(?port_names) + 1, - ?port_names). diff --git a/lib/asn1/src/asn1rt_nif.erl b/lib/asn1/src/asn1rt_nif.erl new file mode 100644 index 0000000000..de1fb94816 --- /dev/null +++ b/lib/asn1/src/asn1rt_nif.erl @@ -0,0 +1,87 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% +-module(asn1rt_nif). + +%% Nif interface for asn1 + +-export([encode_per_complete/1, + decode_ber_tlv/1, + encode_ber_tlv/1]). + +-on_load(load_nif/0). + +-define(ASN1_NIF_VSN,1). + +load_nif() -> + LibBaseName = "asn1_erl_nif", + PrivDir = code:priv_dir(asn1), + LibName = case erlang:system_info(build_type) of + opt -> + LibBaseName; + Type -> + LibTypeName = LibBaseName ++ "." ++ atom_to_list(Type), + case (filelib:wildcard( + filename:join( + [PrivDir, + "lib", + LibTypeName ++ "*"])) /= []) orelse + (filelib:wildcard( + filename:join( + [PrivDir, + "lib", + erlang:system_info(system_architecture), + LibTypeName ++ "*"])) /= []) of + true -> LibTypeName; + false -> LibBaseName + end + end, + Lib = filename:join([PrivDir, "lib", LibName]), + Status = case erlang:load_nif(Lib, ?ASN1_NIF_VSN) of + ok -> ok; + {error, {load_failed, _}}=Error1 -> + ArchLibDir = + filename:join([PrivDir, "lib", + erlang:system_info(system_architecture)]), + Candidate = + filelib:wildcard(filename:join([ArchLibDir,LibName ++ "*" ])), + case Candidate of + [] -> Error1; + _ -> + ArchLib = filename:join([ArchLibDir, LibName]), + erlang:load_nif(ArchLib, ?ASN1_NIF_VSN) + end; + Error1 -> Error1 + end, + case Status of + ok -> ok; + {error, {E, Str}} -> + error_logger:error_msg("Unable to load asn1 nif library. " + "Failed with error:~n\"~p, ~s\"~n",[E,Str]), + Status + end. + +encode_per_complete(_TagValueList) -> + erlang:nif_error({nif_not_loaded,module,?MODULE,line,?LINE}). + +decode_ber_tlv(_Binary) -> + erlang:nif_error({nif_not_loaded,module,?MODULE,line,?LINE}). + +encode_ber_tlv(_TagValueList) -> + erlang:nif_error({nif_not_loaded,module,?MODULE,line,?LINE}). diff --git a/lib/asn1/src/asn1rt_per_bin.erl b/lib/asn1/src/asn1rt_per_bin.erl index 6bbca26209..a124c7553d 100644 --- a/lib/asn1/src/asn1rt_per_bin.erl +++ b/lib/asn1/src/asn1rt_per_bin.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -57,7 +57,7 @@ encode_NumericString/2, decode_NumericString/2, encode_ObjectDescriptor/2, decode_ObjectDescriptor/1 ]). --export([complete_bytes/1]). +-export([complete_bytes/1, getbits/2, getoctets/2]). -define('16K',16384). -define('32K',32768). diff --git a/lib/asn1/src/asn1rt_per_bin_rt2ct.erl b/lib/asn1/src/asn1rt_per_bin_rt2ct.erl index f4aecf9322..c7ead680ce 100644 --- a/lib/asn1/src/asn1rt_per_bin_rt2ct.erl +++ b/lib/asn1/src/asn1rt_per_bin_rt2ct.erl @@ -1734,143 +1734,24 @@ get_constraint(C,Key) -> -ifdef(nodriver). complete(L) -> - case complete1(L) of - {[],[]} -> - <<0>>; - {Acc,[]} -> - Acc; - {Acc,Bacc} -> - [Acc|complete_bytes(Bacc)] - end. - - -% this function builds the ugly form of lists [E1|E2] to avoid having to reverse it at the end. -% this is done because it is efficient and that the result always will be sent on a port or -% converted by means of list_to_binary/1 - complete1(InList) when is_list(InList) -> - complete1(InList,[],[]); - complete1(InList) -> - complete1([InList],[],[]). - - complete1([],Acc,Bacc) -> - {Acc,Bacc}; - complete1([H|T],Acc,Bacc) when is_list(H) -> - {NewH,NewBacc} = complete1(H,Acc,Bacc), - complete1(T,NewH,NewBacc); - - complete1([{octets,Bin}|T],Acc,[]) -> - complete1(T,[Acc|Bin],[]); - - complete1([{octets,Bin}|T],Acc,Bacc) -> - complete1(T,[Acc|[complete_bytes(Bacc),Bin]],[]); - - complete1([{debug,_}|T], Acc,Bacc) -> - complete1(T,Acc,Bacc); - - complete1([{bits,N,Val}|T],Acc,Bacc) -> - complete1(T,Acc,complete_update_byte(Bacc,Val,N)); - - complete1([{bit,Val}|T],Acc,Bacc) -> - complete1(T,Acc,complete_update_byte(Bacc,Val,1)); - - complete1([align|T],Acc,[]) -> - complete1(T,Acc,[]); - complete1([align|T],Acc,Bacc) -> - complete1(T,[Acc|complete_bytes(Bacc)],[]); - complete1([{0,Bin}|T],Acc,[]) when is_binary(Bin) -> - complete1(T,[Acc|Bin],[]); - complete1([{Unused,Bin}|T],Acc,[]) when is_integer(Unused),is_binary(Bin) -> - Size = size(Bin)-1, - <<Bs:Size/binary,B>> = Bin, - NumBits = 8-Unused, - complete1(T,[Acc|Bs],[[B bsr Unused]|NumBits]); - complete1([{Unused,Bin}|T],Acc,Bacc) when is_integer(Unused),is_binary(Bin) -> - Size = size(Bin)-1, - <<Bs:Size/binary,B>> = Bin, - NumBits = 8 - Unused, - Bf = complete_bytes(Bacc), - complete1(T,[Acc|[Bf,Bs]],[[B bsr Unused]|NumBits]). - - - complete_update_byte([],Val,Len) -> - complete_update_byte([[0]|0],Val,Len); - complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) when NumBits + Len == 8 -> - [[0,((Byte bsl Len) + Val) band 255|Bacc]|0]; - complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) when NumBits + Len > 8 -> - Rem = 8 - NumBits, - Rest = Len - Rem, - complete_update_byte([[0,((Byte bsl Rem) + (Val bsr Rest)) band 255 |Bacc]|0],Val,Rest); - complete_update_byte([[Byte|Bacc]|NumBits],Val,Len) -> - [[((Byte bsl Len) + Val) band 255|Bacc]|NumBits+Len]. - - - complete_bytes([[Byte|Bacc]|0]) -> - lists:reverse(Bacc); - complete_bytes([[Byte|Bacc]|NumBytes]) -> - lists:reverse([(Byte bsl (8-NumBytes)) band 255|Bacc]); - complete_bytes([]) -> - []. + erlang_complete(L). -else. -%% asn1-1.6.8.1_dev -%% complete(L) -> -%% case catch port_control(asn1_driver_port,1,L) of -%% Bin when is_binary(Bin) -> -%% Bin; -%% List when is_list(List) -> handle_error(List,L); -%% {'EXIT',{badarg,Reason}} -> -%% asn1rt_driver_handler:load_driver(), -%% receive -%% driver_ready -> -%% case catch port_control(asn1_driver_port,1,L) of -%% Bin2 when is_binary(Bin2) -> Bin2; -%% List when is_list(List) -> handle_error(List,L); -%% {'EXIT',Reason2={badarg,_R}} -> -%% exit({"failed to call driver probably due to bad asn1 value",Reason2}); -%% Reason2 -> exit(Reason2) -%% end; -%% {error,Error} -> % error when loading driver -%% %% the driver could not be loaded -%% exit(Error); -%% Error={port_error,Reason} -> -%% exit(Error) -%% end; -%% {'EXIT',Reason} -> -%% exit(Reason) -%% end. - -%% asn1-1.6.9 +%% asn1-1.7 complete(L) -> - case catch control(?COMPLETE_ENCODE,L) of - Bin when is_binary(Bin) -> - Bin; - List when is_list(List) -> handle_error(List,L); - {'EXIT',{badarg,_Reason}} -> - case asn1rt:load_driver() of - ok -> - case control(?COMPLETE_ENCODE,L) of - Bin when is_binary(Bin) ->Bin; - List when is_list(List) -> handle_error(List,L) - end; - Err -> - Err - end + case asn1rt_nif:encode_per_complete(L) of + {error, Reason} -> handle_error(Reason, L); + Else when is_binary(Else) -> Else end. - handle_error([],_)-> exit({error,{asn1,{"memory allocation problem in driver"}}}); -handle_error("1",L) -> % error in complete in driver +handle_error($1,L) -> % error in complete in driver exit({error,{asn1,L}}); handle_error(ErrL,L) -> exit({error,{asn1,ErrL,L}}). -%% asn1-1.6.9 -control(Cmd, Data) -> - Port = asn1rt_driver_handler:client_port(), - erlang:port_control(Port, Cmd, Data). - -endif. diff --git a/lib/asn1/test/asn1.cover b/lib/asn1/test/asn1.cover index 589a8b7e3d..ad3a0f3db9 100644 --- a/lib/asn1/test/asn1.cover +++ b/lib/asn1/test/asn1.cover @@ -1,2 +1,3 @@ {incl_app,asn1,details}. +{excl_mods, asn1, [asn1rt_nif]}.
\ No newline at end of file diff --git a/lib/asn1/test/asn1_SUITE.erl.src b/lib/asn1/test/asn1_SUITE.erl.src index e7f93a4053..124ee2d2bb 100644 --- a/lib/asn1/test/asn1_SUITE.erl.src +++ b/lib/asn1/test/asn1_SUITE.erl.src @@ -2036,11 +2036,7 @@ rtUI(Config) -> ?line {ok,_} = asn1rt:info('Prim'), ?line ok = asn1ct:compile(filename:join(DataDir,"Prim"),[?PER]), - ?line {ok,_} = asn1rt:info('Prim'), - - ?line ok = asn1rt:load_driver(), - ?line ok = asn1rt:load_driver(), - ?line ok = asn1rt:unload_driver(). + ?line {ok,_} = asn1rt:info('Prim'). testROSE(suite) -> []; testROSE(Config) -> diff --git a/lib/asn1/test/asn1_bin_v2_particular_SUITE.erl.src b/lib/asn1/test/asn1_bin_v2_particular_SUITE.erl.src index abd21b0d78..4c3c8c7808 100644 --- a/lib/asn1/test/asn1_bin_v2_particular_SUITE.erl.src +++ b/lib/asn1/test/asn1_bin_v2_particular_SUITE.erl.src @@ -11,37 +11,219 @@ smp(Config) -> ?line Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, ?line ok = testNBAPsystem:compile(Config,per_bin,[optimize]), - - Parent = self(), - ?line ok = asn1rt:load_driver(), - - smp2(Parent,NumOfProcs,Msg,2), + enc_dec(NumOfProcs,Msg,2), N = 10000, - ?line {Time1,ok} = timer:tc(?MODULE,smp2,[Parent,NumOfProcs,Msg, N]), - ?line {Time1S,ok} = timer:tc(?MODULE,sequential,[NumOfProcs * N,Msg]), + ?line {Time1,ok} = timer:tc(?MODULE,enc_dec,[NumOfProcs,Msg, N]), + ?line {Time1S,ok} = timer:tc(?MODULE,enc_dec,[1, Msg, NumOfProcs * N]), - ?line ok = testNBAPsystem:compile(Config,ber_bin,[optimize,driver]), - ?line {Time2,ok} = timer:tc(?MODULE,smp2,[Parent,NumOfProcs,Msg, N]), + ?line ok = testNBAPsystem:compile(Config,ber_bin,[optimize,nif]), + ?line {Time3,ok} = timer:tc(?MODULE,enc_dec,[NumOfProcs,Msg, N]), - ?line {Time2S,ok} = timer:tc(?MODULE,sequential,[NumOfProcs * N,Msg]), + ?line {Time3S,ok} = timer:tc(?MODULE,enc_dec,[1, Msg, NumOfProcs * N]), - {comment,lists:flatten(io_lib:format("Encode/decode time parallell with ~p cores: ~p [microsecs]~nEncode/decode time sequential: ~p [microsecs]",[NumOfProcs,Time1+Time2,Time1S+Time2S]))}; + {comment,lists:flatten( + io_lib:format( + "Encode/decode time parallell with ~p cores: ~p [microsecs]~n" + "Encode/decode time sequential: ~p [microsecs]", + [NumOfProcs,Time1+Time3,Time1S+Time3S]))}; false -> {skipped,"No smp support"} end. -smp2(Parent,NumOfProcs,Msg, N) -> - Pids = [spawn_link(fun() -> worker(Msg,Parent, N) end) - || _ <- lists:seq(1,NumOfProcs)], - ?line ok = wait_pids(Pids). +per_performance(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + NifDir = filename:join(PrivDir,"nif"), + ErlDir = filename:join(PrivDir,"erl"), + file:make_dir(NifDir),file:make_dir(ErlDir), + + ?line Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, + ?line ok = testNBAPsystem:compile([{priv_dir,NifDir}|Config],per_bin, + [optimize]), + ?line ok = testNBAPsystem:compile([{priv_dir,ErlDir}|Config],per_bin, + []), + + Modules = ['NBAP-CommonDataTypes', + 'NBAP-Constants', + 'NBAP-Containers', + 'NBAP-IEs', + 'NBAP-PDU-Contents', + 'NBAP-PDU-Discriptions'], + + + PreNif = fun() -> + code:add_patha(NifDir), + lists:foreach(fun(M) -> + code:purge(M), + code:load_file(M) + end,Modules) + end, + + PreErl = fun() -> + code:add_patha(ErlDir), + lists:foreach(fun(M) -> + code:purge(M), + code:load_file(M) + end,Modules) + end, + + Func = fun() -> + element(1,timer:tc( + asn1_wrapper,encode,['NBAP-PDU-Discriptions', + 'NBAP-PDU', + Msg])) + end, + + nif_vs_erlang_performance({{{PreNif,Func},{PreErl,Func}},100000,32}). + +ber_performance(Config) -> + + ?line Msg = {initiatingMessage, testNBAPsystem:cell_setup_req_msg()}, + ?line ok = testNBAPsystem:compile(Config,ber_bin,[optimize,nif]), + + + BerFun = fun() -> + {ok,B} = asn1_wrapper:encode('NBAP-PDU-Discriptions', + 'NBAP-PDU', Msg), + asn1_wrapper:decode( + 'NBAP-PDU-Discriptions', + 'NBAP-PDU', + B) + end, + nif_vs_erlang_performance({BerFun,100000,32}). + +cert_pem_performance(Config) when is_list(Config) -> + cert_pem_performance({100000, 32}); +cert_pem_performance({N,S}) -> + nif_vs_erlang_performance({fun cert_pem/0,N,S}). + +dsa_pem_performance(Config) when is_list(Config) -> + cert_pem_performance({100000, 32}); +dsa_pem_performance({N,S}) -> + nif_vs_erlang_performance({fun dsa_pem/0,N,S}). + + +nif_vs_erlang_performance({{TC1,TC2},N,Sched}) -> + random:seed({123,456,789}), + io:format("Running a ~p sample with ~p max procs...~n~n",[N,Sched]), + + {True,False} = exec(TC1,TC2,Sched,N+1), + + io:format("~ndone!~n"), + + io:format("~n"),TStats = print_stats(strip(True,N div 20)), + io:format("~n"),FStats = print_stats(strip(False,N div 20)), + Str = io_lib:format("~nNifs are ~.3f% faster than erlang!~n", + [(element(2,FStats) - element(2,TStats)) / + element(2,FStats) * 100]), + io:format(Str), + {comment, lists:flatten(Str)}; +nif_vs_erlang_performance({T,N,Sched}) -> + PTC1 = fun() -> + application:set_env(asn1, nif_loadable, true) + end, + PTC2 = fun() -> + application:set_env(asn1, nif_loadable, false) + end, + TC = fun() -> + element(1,timer:tc(T)) + end, + nif_vs_erlang_performance({{{PTC1,TC},{PTC2,TC}},N,Sched}). + + +print_stats(Data) -> + Length = length(Data), + Mean = lists:sum(Data) / Length, + Variance = lists:foldl(fun(N,Acc) -> math:pow(N - Mean, 2)+Acc end, 0, Data), + StdDev = math:sqrt(Variance / Length), + Median = lists:nth(round(Length/2),Data), + Min = lists:min(Data), + Max = lists:max(Data), + if Length < 20 -> + io:format("Data: ~w~n",[Data]); + true -> + ok + end, + io:format("Length: ~p~nMean: ~p~nStdDev: ~p~nMedian: ~p~nMin: ~p~nMax: ~p~n", + [Length,Mean,StdDev,Median,Min,Max]), + {Length,Mean,StdDev,Median,Min,Max}. + +collect(Acc) -> + receive + {Tag,Val} -> + Prev = proplists:get_value(Tag,Acc,[]), + collect(lists:keystore(Tag,1,Acc,{Tag,[Val|Prev]})) + after 100 -> + Acc + end. + +exec(One,Two,Max,N) -> + exec(One,Two,Max,N,{[],[]}). +exec(_,_,_,1,{D1,D2}) -> + {lists:flatten(D1),lists:flatten(D2)}; +exec({PreOne,One} = O,{PreTwo,Two} = T,MaxProcs, N, {D1,D2}) -> + Num = random:uniform(round(N/2)), + if Num rem 3 == 0 -> + timer:sleep(Num rem 1000); + true -> + ok + end, + Procs = random:uniform(MaxProcs), + io:format("\tBatch: ~p items in ~p processes, ~p left~n",[Num,Procs,N-Num]), + if Num rem 2 == 1 -> + erlang:garbage_collect(), + PreOne(), + MoreOne = pexec(One, Num, Procs, []), + erlang:garbage_collect(), + PreTwo(), + MoreTwo = pexec(Two, Num, Procs, []); + true -> + erlang:garbage_collect(), + PreTwo(), + MoreTwo = pexec(Two, Num, Procs, []), + erlang:garbage_collect(), + PreOne(), + MoreOne = pexec(One, Num, Procs, []) + end, + exec(O,T,MaxProcs,N-Num,{[MoreOne|D1], + [MoreTwo|D2]}). + +pexec(_Fun, _, 0, []) -> + []; +pexec(Fun, _, 0, [{Ref,Pid}|Rest]) -> + receive + {data,D} -> + [D|pexec(Fun,0,0,[{Ref,Pid}|Rest])]; + {'DOWN', Ref, process, Pid, normal} -> + pexec(Fun, 0,0,Rest) + end; +pexec(Fun, 0, 1, AccProcs) -> + pexec(Fun, 0, 0, AccProcs); +pexec(Fun, N, 1, AccProcs) -> + [Fun()|pexec(Fun, N - 1, 1, AccProcs)]; +pexec(Fun, N, Procs, AccProcs) -> + S = self(), + Pid = spawn(fun() -> + S ! {data,pexec(Fun,N,1,[])} + end), + Ref = erlang:monitor(process, Pid), + pexec(Fun, N, Procs - 1, [{Ref,Pid}|AccProcs]). -worker(Msg, Parent, N) -> - %% io:format("smp worker ~p with ~p worker loops.~n",[self(), N]), - worker_loop(N, Msg), - Parent ! self(). +strip(Data,Num) -> + {_,R} = lists:split(Num,lists:sort(Data)), + element(2,lists:split(Num,lists:reverse(R))). + +faster(A,B) -> + (B - A)/B * 100. + +enc_dec(1, Msg, N) -> + worker_loop(N, Msg); +enc_dec(NumOfProcs,Msg, N) -> + pforeach(fun(_) -> + worker_loop(N, Msg) + end, [I || I <- lists:seq(1,NumOfProcs)]). worker_loop(0, _Msg) -> ok; @@ -50,28 +232,24 @@ worker_loop(N, Msg) -> 'NBAP-PDU', Msg), ?line {ok,_Msg}=asn1_wrapper:decode('NBAP-PDU-Discriptions', - 'NBAP-PDU', - B), + 'NBAP-PDU', + B), worker_loop(N - 1, Msg). -wait_pids([]) -> - ok; -wait_pids(Pids) -> +pforeach(Fun, List) -> + pforeach(Fun, List, []). +pforeach(Fun, [], [{Pid,Ref}|Pids]) -> receive - Pid when is_pid(Pid) -> - ?line true = lists:member(Pid,Pids), - Others = lists:delete(Pid,Pids), - io:format("wait_pid got ~p, still waiting for ~p\n",[Pid,Others]), - wait_pids(Others); - Err -> - io:format("Err: ~p~n",[Err]), - ?line exit(Err) - end. - -sequential(N,Msg) -> - %%io:format("sequential encode/decode with N = ~p~n",[N]), - worker_loop(N,Msg). + {'DOWN', Ref, process, Pid, normal} -> + pforeach(Fun, [], Pids) + end; +pforeach(Fun, [H|T], Pids) -> + Pid = spawn(fun() -> Fun(H) end), + Ref = erlang:monitor(process, Pid), + pforeach(Fun, T, [{Pid, Ref}|Pids]); +pforeach(_Fun,[],[]) -> + ok. -record('InitiatingMessage',{procedureCode,criticality,value}). -record('Iu-ReleaseCommand',{first,second}). @@ -93,3 +271,21 @@ ticket7904(Config) -> ?line {ok,_} = 'RANAPextract1':encode('InitiatingMessage', Val1), asn1rt:unload_driver(), ?line {ok,_} = 'RANAPextract1':encode('InitiatingMessage', Val1). + +cert_pem() -> + 'OTP-PUB-KEY':decode('Certificate',<<48,130,3,184,48,130,3,33,160,3,2,1,2,2,1,1,48,13,6,9,42,134,72,134,247,13,1,1,5,5,0,48,129,131,49,14,48,12,6,3,85,4,3,19,5,111,116,112,67,65,49,19,48,17,6,3,85,4,11,19,10,69,114,108,97,110,103,32,79,84,80,49,20,48,18,6,3,85,4,10,19,11,69,114,105,99,115,115,111,110,32,65,66,49,11,48,9,6,3,85,4,6,19,2,83,69,49,18,48,16,6,3,85,4,7,19,9,83,116,111,99,107,104,111,108,109,49,37,48,35,6,9,42,134,72,134,247,13,1,9,1,22,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,48,30,23,13,48,56,48,49,48,57,48,56,50,57,51,48,90,23,13,49,55,49,49,49,55,48,56,50,57,51,48,90,48,129,132,49,15,48,13,6,3,85,4,3,19,6,99,108,105,101,110,116,49,19,48,17,6,3,85,4,11,19,10,69,114,108,97,110,103,32,79,84,80,49,20,48,18,6,3,85,4,10,19,11,69,114,105,99,115,115,111,110,32,65,66,49,11,48,9,6,3,85,4,6,19,2,83,69,49,18,48,16,6,3,85,4,7,19,9,83,116,111,99,107,104,111,108,109,49,37,48,35,6,9,42,134,72,134,247,13,1,9,1,22,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,48,129,159,48,13,6,9,42,134,72,134,247,13,1,1,1,5,0,3,129,141,0,48,129,137,2,129,129,0,245,56,68,254,220,239,193,190,63,221,182,60,67,77,121,163,214,136,137,183,139,8,166,30,100,27,45,17,126,58,15,173,151,218,75,224,148,14,22,164,10,100,186,183,104,175,197,97,96,182,146,150,106,129,140,100,194,106,90,62,133,233,155,46,155,33,101,220,83,193,182,232,240,99,253,249,114,8,159,172,143,77,179,132,229,205,29,110,185,233,224,52,25,149,249,100,80,229,199,125,23,106,146,233,159,26,13,8,161,206,221,43,240,149,42,45,194,190,85,6,235,152,220,219,160,32,144,67,2,3,1,0,1,163,130,1,55,48,130,1,51,48,9,6,3,85,29,19,4,2,48,0,48,11,6,3,85,29,15,4,4,3,2,5,224,48,29,6,3,85,29,14,4,22,4,20,26,59,44,5,72,211,158,214,23,34,30,241,125,27,123,115,93,163,231,120,48,129,179,6,3,85,29,35,4,129,171,48,129,168,128,20,6,171,128,52,58,164,184,118,178,189,157,46,40,229,109,145,222,125,1,155,161,129,140,164,129,137,48,129,134,49,17,48,15,6,3,85,4,3,19,8,101,114,108,97,110,103,67,65,49,19,48,17,6,3,85,4,11,19,10,69,114,108,97,110,103,32,79,84,80,49,20,48,18,6,3,85,4,10,19,11,69,114,105,99,115,115,111,110,32,65,66,49,18,48,16,6,3,85,4,7,19,9,83,116,111,99,107,104,111,108,109,49,11,48,9,6,3,85,4,6,19,2,83,69,49,37,48,35,6,9,42,134,72,134,247,13,1,9,1,22,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,130,1,1,48,33,6,3,85,29,17,4,26,48,24,129,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,48,33,6,3,85,29,18,4,26,48,24,129,22,112,101,116,101,114,64,101,114,105,120,46,101,114,105,99,115,115,111,110,46,115,101,48,13,6,9,42,134,72,134,247,13,1,1,5,5,0,3,129,129,0,93,11,112,227,121,15,121,179,247,135,110,216,17,197,84,18,149,166,147,142,190,178,0,209,190,0,142,233,144,100,194,205,220,182,73,204,108,42,95,23,48,63,4,120,239,42,194,25,184,35,117,107,96,229,18,45,76,122,125,40,171,210,132,50,146,178,160,55,17,35,255,208,114,30,47,55,185,154,155,165,204,180,14,143,20,234,6,234,201,225,72,235,5,87,61,255,250,23,217,1,144,246,98,221,223,102,49,168,177,13,70,241,26,27,254,251,217,14,244,18,242,197,151,50,186,214,15,42>>). + +dsa_pem() -> + 'OTP-PUB-KEY':decode('DSAPrivateKey',<<48,130,1,187,2,1,0,2,129,129,0,183,179,230,217,37,99,144,157,21,228,204,162,207,61,246,144,58,139,139,184,184,43,108,206,0,115,173,208,100,233,201,121,21,90,179,119,53,140,25,52,34,202,121,211,164,107,43,56,68,162,159,51,244,232,138,126,164,109,121,89,237,142,57,28,32,188,44,67,253,111,121,104,40,141,211,255,140,118,37,234,150,201,155,160,16,17,51,59,26,249,41,129,16,211,119,128,95,254,182,235,132,0,92,206,93,77,106,217,201,132,203,4,75,201,246,204,216,162,1,84,79,211,10,21,152,195,103,145,2,21,0,213,30,184,86,247,16,247,69,192,241,35,138,84,57,140,3,71,65,206,233,2,129,129,0,148,179,24,63,74,91,128,25,96,29,5,78,223,246,175,0,121,86,54,178,42,231,98,241,147,180,157,60,149,160,50,243,227,76,175,89,234,203,252,242,76,108,9,204,157,182,59,206,227,127,99,215,42,156,194,78,116,25,7,62,243,169,45,5,101,179,247,127,199,144,135,103,23,42,154,125,231,248,154,101,175,155,101,42,232,41,80,41,47,128,208,11,31,106,63,12,202,207,135,80,200,136,250,171,31,118,52,91,200,138,112,111,179,23,214,123,21,118,194,179,0,185,217,52,197,182,236,13,2,129,128,124,66,0,111,121,139,142,209,95,136,95,237,177,150,248,252,49,135,117,100,155,232,138,244,132,89,40,5,70,125,202,96,78,239,76,37,125,149,82,64,107,54,227,73,25,180,227,41,0,234,73,47,80,242,242,129,250,61,68,62,39,38,156,193,146,40,241,247,106,215,223,202,194,110,130,62,186,90,18,28,196,174,99,47,193,61,130,100,150,25,248,115,164,231,153,99,46,69,66,139,33,187,51,49,35,219,234,29,44,172,166,247,42,16,177,187,9,162,81,243,33,26,100,46,78,57,203,135,2,20,89,128,159,14,187,249,182,172,15,88,162,110,211,71,179,209,29,125,217,38>>), + 'OTP-PUB-KEY':decode('SubjectPublicKeyInfo',<<48,130,1,183,48,130,1,44,6,7,42,134,72,206,56,4,1,48,130,1,31,2,129,129,0,183,179,230,217,37,99,144,157,21,228,204,162,207,61,246,144,58,139,139,184,184,43,108,206,0,115,173,208,100,233,201,121,21,90,179,119,53,140,25,52,34,202,121,211,164,107,43,56,68,162,159,51,244,232,138,126,164,109,121,89,237,142,57,28,32,188,44,67,253,111,121,104,40,141,211,255,140,118,37,234,150,201,155,160,16,17,51,59,26,249,41,129,16,211,119,128,95,254,182,235,132,0,92,206,93,77,106,217,201,132,203,4,75,201,246,204,216,162,1,84,79,211,10,21,152,195,103,145,2,21,0,213,30,184,86,247,16,247,69,192,241,35,138,84,57,140,3,71,65,206,233,2,129,129,0,148,179,24,63,74,91,128,25,96,29,5,78,223,246,175,0,121,86,54,178,42,231,98,241,147,180,157,60,149,160,50,243,227,76,175,89,234,203,252,242,76,108,9,204,157,182,59,206,227,127,99,215,42,156,194,78,116,25,7,62,243,169,45,5,101,179,247,127,199,144,135,103,23,42,154,125,231,248,154,101,175,155,101,42,232,41,80,41,47,128,208,11,31,106,63,12,202,207,135,80,200,136,250,171,31,118,52,91,200,138,112,111,179,23,214,123,21,118,194,179,0,185,217,52,197,182,236,13,3,129,132,0,2,129,128,124,66,0,111,121,139,142,209,95,136,95,237,177,150,248,252,49,135,117,100,155,232,138,244,132,89,40,5,70,125,202,96,78,239,76,37,125,149,82,64,107,54,227,73,25,180,227,41,0,234,73,47,80,242,242,129,250,61,68,62,39,38,156,193,146,40,241,247,106,215,223,202,194,110,130,62,186,90,18,28,196,174,99,47,193,61,130,100,150,25,248,115,164,231,153,99,46,69,66,139,33,187,51,49,35,219,234,29,44,172,166,247,42,16,177,187,9,162,81,243,33,26,100,46,78,57,203,135>>), + 'OTP-PUB-KEY':decode('DSAParams',<<48,130,1,31,2,129,129,0,183,179,230,217,37,99,144,157,21,228,204,162,207,61,246,144,58,139,139,184,184,43,108,206,0,115,173,208,100,233,201,121,21,90,179,119,53,140,25,52,34,202,121,211,164,107,43,56,68,162,159,51,244,232,138,126,164,109,121,89,237,142,57,28,32,188,44,67,253,111,121,104,40,141,211,255,140,118,37,234,150,201,155,160,16,17,51,59,26,249,41,129,16,211,119,128,95,254,182,235,132,0,92,206,93,77,106,217,201,132,203,4,75,201,246,204,216,162,1,84,79,211,10,21,152,195,103,145,2,21,0,213,30,184,86,247,16,247,69,192,241,35,138,84,57,140,3,71,65,206,233,2,129,129,0,148,179,24,63,74,91,128,25,96,29,5,78,223,246,175,0,121,86,54,178,42,231,98,241,147,180,157,60,149,160,50,243,227,76,175,89,234,203,252,242,76,108,9,204,157,182,59,206,227,127,99,215,42,156,194,78,116,25,7,62,243,169,45,5,101,179,247,127,199,144,135,103,23,42,154,125,231,248,154,101,175,155,101,42,232,41,80,41,47,128,208,11,31,106,63,12,202,207,135,80,200,136,250,171,31,118,52,91,200,138,112,111,179,23,214,123,21,118,194,179,0,185,217,52,197,182,236,13>>), + 'OTP-PUB-KEY':decode('DSAPublicKey',<<2,129,128,124,66,0,111,121,139,142,209,95,136,95,237,177,150,248,252,49,135,117,100,155,232,138,244,132,89,40,5,70,125,202,96,78,239,76,37,125,149,82,64,107,54,227,73,25,180,227,41,0,234,73,47,80,242,242,129,250,61,68,62,39,38,156,193,146,40,241,247,106,215,223,202,194,110,130,62,186,90,18,28,196,174,99,47,193,61,130,100,150,25,248,115,164,231,153,99,46,69,66,139,33,187,51,49,35,219,234,29,44,172,166,247,42,16,177,187,9,162,81,243,33,26,100,46,78,57,203,135>>), + 'OTP-PUB-KEY':encode('DSAParams',{params,{'Dss-Parms',129000451850199666185842362389296595317127259539517666765336291347244303954511451744518587442120964433734460998523119938005801396466878889993179871123036311260456172022864663021425348874648247531097042575063545128239655736096045972718934778583429973433661785691086624069991876932064334822608460064613803976593,1216700114794736143432235288305776850295620488937,104420402274523493329542694749036577763086597934731674202966304958550599470165597750883637440049774107540742087494301536297571301945349213110548764383811017178451900599240379681904765817950545426764751538502808499880604633364255316249231153053427235538288687666086821781456733226598288985591031656134573747213}}), + 'OTP-PUB-KEY':encode( + 'SubjectPublicKeyInfo', + {'SubjectPublicKeyInfo', + {'AlgorithmIdentifier', + {1,2,840,10040,4,1}, + <<48,130,1,31,2,129,129,0,183,179,230,217,37,99,144,157,21,228,204,162,207,61,246,144,58,139,139,184,184,43,108,206,0,115,173,208,100,233,201,121,21,90,179,119,53,140,25,52,34,202,121,211,164,107,43,56,68,162,159,51,244,232,138,126,164,109,121,89,237,142,57,28,32,188,44,67,253,111,121,104,40,141,211,255,140,118,37,234,150,201,155,160,16,17,51,59,26,249,41,129,16,211,119,128,95,254,182,235,132,0,92,206,93,77,106,217,201,132,203,4,75,201,246,204,216,162,1,84,79,211,10,21,152,195,103,145,2,21,0,213,30,184,86,247,16,247,69,192,241,35,138,84,57,140,3,71,65,206,233,2,129,129,0,148,179,24,63,74,91,128,25,96,29,5,78,223,246,175,0,121,86,54,178,42,231,98,241,147,180,157,60,149,160,50,243,227,76,175,89,234,203,252,242,76,108,9,204,157,182,59,206,227,127,99,215,42,156,194,78,116,25,7,62,243,169,45,5,101,179,247,127,199,144,135,103,23,42,154,125,231,248,154,101,175,155,101,42,232,41,80,41,47,128,208,11,31,106,63,12,202,207,135,80,200,136,250,171,31,118,52,91,200,138,112,111,179,23,214,123,21,118,194,179,0,185,217,52,197,182,236,13>>}, + {0, + <<2,129,128,124,66,0,111,121,139,142,209,95,136,95,237,177,150,248,252,49,135,117,100,155,232,138,244,132,89,40,5,70,125,202,96,78,239,76,37,125,149,82,64,107,54,227,73,25,180,227,41,0,234,73,47,80,242,242,129,250,61,68,62,39,38,156,193,146,40,241,247,106,215,223,202,194,110,130,62,186,90,18,28,196,174,99,47,193,61,130,100,150,25,248,115,164,231,153,99,46,69,66,139,33,187,51,49,35,219,234,29,44,172,166,247,42,16,177,187,9,162,81,243,33,26,100,46,78,57,203,135>>}}). diff --git a/lib/asn1/test/ber_decode_error.erl b/lib/asn1/test/ber_decode_error.erl index 96d6545636..a566e0b07f 100644 --- a/lib/asn1/test/ber_decode_error.erl +++ b/lib/asn1/test/ber_decode_error.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -45,6 +45,10 @@ run([]) -> run([driver]) -> %% test of OTP-4797, bad indata to driver does not cause an EXIT ?line {error,_Reason} = asn1rt:decode('Constructed','S3',[3,5]), + ok; +run([nif]) -> + %% test of OTP-4797, bad indata to driver does not cause an EXIT + ?line {error,_Reason} = asn1rt:decode('Constructed','S3',[3,5]), ok. diff --git a/lib/asn1/test/testPrim.erl b/lib/asn1/test/testPrim.erl index 97f99e7b1c..39c1e4d1d8 100644 --- a/lib/asn1/test/testPrim.erl +++ b/lib/asn1/test/testPrim.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -37,21 +37,10 @@ compile(Config,Rules,Opt) -> ?line DataDir = ?config(data_dir,Config), ?line OutDir = ?config(priv_dir,Config), ?line true = code:add_patha(?config(priv_dir,Config)), - case Opt of - [optimize] -> - ?line ok = asn1ct:compile(DataDir ++ "Prim", - [Rules,optimize,{outdir,OutDir}]), - ?line ok = asn1ct:compile(DataDir ++ "Real", - [Rules,optimize,{outdir,OutDir}]); - __ -> - ?line ok = asn1ct:compile(DataDir ++ "Prim", - [Rules,{outdir,OutDir}]), - ?line ok = asn1ct:compile(DataDir ++ "Real", - [Rules,{outdir,OutDir}]) - end. - - - + ?line ok = asn1ct:compile(DataDir ++ "Prim", + [Rules,{outdir,OutDir}] ++ Opt), + ?line ok = asn1ct:compile(DataDir ++ "Real", + [Rules,{outdir,OutDir}] ++ Opt). bool(Rules) -> diff --git a/lib/common_test/include/ct.hrl b/lib/common_test/include/ct.hrl index aa1cc832cf..5a77108e1a 100644 --- a/lib/common_test/include/ct.hrl +++ b/lib/common_test/include/ct.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% Copyright Ericsson AB 2003-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -18,5 +18,4 @@ %% -include_lib("test_server/include/test_server.hrl"). --compile({parse_transform,ct_line}). diff --git a/lib/common_test/src/Makefile b/lib/common_test/src/Makefile index 84b122b5e4..5b23558a96 100644 --- a/lib/common_test/src/Makefile +++ b/lib/common_test/src/Makefile @@ -40,7 +40,6 @@ RELSYSDIR = $(RELEASE_PATH)/lib/common_test-$(VSN) # ---------------------------------------------------- MODULES= \ - ct_line \ ct \ ct_logs \ ct_framework \ @@ -72,6 +71,7 @@ MODULES= \ ct_hooks_lock TARGET_MODULES= $(MODULES:%=$(EBIN)/%) +BEAM_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) ERL_FILES= $(MODULES:=.erl) HRL_FILES = \ @@ -97,7 +97,7 @@ ERL_COMPILE_FLAGS += -pa ../ebin -I../include -I $(ERL_TOP)/lib/snmp/include/ \ # ---------------------------------------------------- TARGET_FILES = \ $(GEN_ERL_FILES:%.erl=$(EBIN)/%.$(EMULATOR)) \ - $(MODULES:%=$(EBIN)/%.$(EMULATOR)) \ + $(BEAM_FILES) \ $(APP_TARGET) $(APPUP_TARGET) APP_FILE= common_test.app diff --git a/lib/common_test/src/common_test.app.src b/lib/common_test/src/common_test.app.src index b42173f412..57606c01db 100644 --- a/lib/common_test/src/common_test.app.src +++ b/lib/common_test/src/common_test.app.src @@ -25,7 +25,6 @@ ct_framework, ct_ftp, ct_gen_conn, - ct_line, ct_logs, ct_make, ct_master, diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index f243b87f54..d5b585a831 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -331,7 +331,7 @@ catch_apply(M,F,A, Default) -> catch error:Reason -> case erlang:get_stacktrace() of %% Return the default if it was the CTH module which did not have the function. - [{M,F,A}|_] when Reason == undef -> + [{M,F,A,_}|_] when Reason == undef -> Default; Trace -> ct_logs:log("Suite Hook","Call to CTH failed: ~p:~p", diff --git a/lib/common_test/src/ct_line.erl b/lib/common_test/src/ct_line.erl deleted file mode 100644 index 4af9da5463..0000000000 --- a/lib/common_test/src/ct_line.erl +++ /dev/null @@ -1,266 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% - -%%% @doc Parse transform for inserting line numbers - --module(ct_line). - --record(vars, {module, % atom() Module name - vsn, % atom() - - init_info=[], % [{M,F,A,C,L}] - - function, % atom() - arity, % int() - clause, % int() - lines, % [int()] - depth, % int() - is_guard=false % boolean - }). - --export([parse_transform/2, - line/1]). - -line(LOC={{Mod,Func},_Line}) -> - Lines = case get(test_server_loc) of - [{{Mod,Func},_}|Ls] -> - Ls; - Ls when is_list(Ls) -> - case length(Ls) of - 10 -> - [_|T]=lists:reverse(Ls), - lists:reverse(T); - _ -> - Ls - end; - _ -> - [] - end, - put(test_server_loc,[LOC|Lines]). - -parse_transform(Forms, _Options) -> - transform(Forms, _Options). - -%% forms(Fs) -> lists:map(fun (F) -> form(F) end, Fs). - -transform(Forms, _Options)-> - Vars0 = #vars{}, - {ok, MungedForms, _Vars} = transform(Forms, [], Vars0), - MungedForms. - - -transform([Form|Forms], MungedForms, Vars) -> - case munge(Form, Vars) of - ignore -> - transform(Forms, MungedForms, Vars); - {MungedForm, Vars2} -> - transform(Forms, [MungedForm|MungedForms], Vars2) - end; -transform([], MungedForms, Vars) -> - {ok, lists:reverse(MungedForms), Vars}. - -%% This code traverses the abstract code, stored as the abstract_code -%% chunk in the BEAM file, as described in absform(3) for Erlang/OTP R8B -%% (Vsn=abstract_v2). -%% The abstract format after preprocessing differs slightly from the abstract -%% format given eg using epp:parse_form, this has been noted in comments. -munge(Form={attribute,_,module,Module}, Vars) -> - Vars2 = Vars#vars{module=Module}, - {Form, Vars2}; - -munge({function,0,module_info,_Arity,_Clauses}, _Vars) -> - ignore; % module_info will be added again when the forms are recompiled -munge({function,Line,Function,Arity,Clauses}, Vars) -> - Vars2 = Vars#vars{function=Function, - arity=Arity, - clause=1, - lines=[], - depth=1}, - {MungedClauses, Vars3} = munge_clauses(Clauses, Vars2, []), - {{function,Line,Function,Arity,MungedClauses}, Vars3}; -munge(Form, Vars) -> % attributes - {Form, Vars}. - -munge_clauses([{clause,Line,Pattern,Guards,Body}|Clauses], Vars, MClauses) -> - {MungedGuards, _Vars} = munge_exprs(Guards, Vars#vars{is_guard=true},[]), - - case Vars#vars.depth of - 1 -> % function clause - {MungedBody, Vars2} = munge_body(Body, Vars#vars{depth=2}, []), - ClauseInfo = {Vars2#vars.module, - Vars2#vars.function, - Vars2#vars.arity, - Vars2#vars.clause, - length(Vars2#vars.lines)}, - InitInfo = [ClauseInfo | Vars2#vars.init_info], - Vars3 = Vars2#vars{init_info=InitInfo, - clause=(Vars2#vars.clause)+1, - lines=[], - depth=1}, - munge_clauses(Clauses, Vars3, - [{clause,Line,Pattern,MungedGuards,MungedBody}| - MClauses]); - - 2 -> % receive-, case- or if clause - {MungedBody, Vars2} = munge_body(Body, Vars, []), - munge_clauses(Clauses, Vars2, - [{clause,Line,Pattern,MungedGuards,MungedBody}| - MClauses]) - end; -munge_clauses([], Vars, MungedClauses) -> - {lists:reverse(MungedClauses), Vars}. - -munge_body([Expr|Body], Vars, MungedBody) -> - %% Here is the place to add a call to cover:bump/6! - Line = element(2, Expr), - Lines = Vars#vars.lines, - case lists:member(Line,Lines) of - true -> % already a bump at this line! - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_body(Body, Vars2, [MungedExpr|MungedBody]); - false -> - Bump = {call, 0, {remote,0,{atom,0,?MODULE},{atom,0,line}}, - [{tuple,0,[{tuple,0,[{atom,0,Vars#vars.module}, - {atom, 0, Vars#vars.function}]}, - {integer, 0, Line}]}]}, - Lines2 = [Line|Lines], - - {MungedExpr, Vars2} = munge_expr(Expr, Vars#vars{lines=Lines2}), - munge_body(Body, Vars2, [MungedExpr,Bump|MungedBody]) - end; -munge_body([], Vars, MungedBody) -> - {lists:reverse(MungedBody), Vars}. - -munge_expr({match,Line,ExprL,ExprR}, Vars) -> - {MungedExprL, Vars2} = munge_expr(ExprL, Vars), - {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), - {{match,Line,MungedExprL,MungedExprR}, Vars3}; -munge_expr({tuple,Line,Exprs}, Vars) -> - {MungedExprs, Vars2} = munge_exprs(Exprs, Vars, []), - {{tuple,Line,MungedExprs}, Vars2}; -munge_expr({record,Line,Expr,Exprs}, Vars) -> - %% Only for Vsn=raw_abstract_v1 - {MungedExprName, Vars2} = munge_expr(Expr, Vars), - {MungedExprFields, Vars3} = munge_exprs(Exprs, Vars2, []), - {{record,Line,MungedExprName,MungedExprFields}, Vars3}; -munge_expr({record_field,Line,ExprL,ExprR}, Vars) -> - %% Only for Vsn=raw_abstract_v1 - {MungedExprL, Vars2} = munge_expr(ExprL, Vars), - {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), - {{record_field,Line,MungedExprL,MungedExprR}, Vars3}; -munge_expr({cons,Line,ExprH,ExprT}, Vars) -> - {MungedExprH, Vars2} = munge_expr(ExprH, Vars), - {MungedExprT, Vars3} = munge_expr(ExprT, Vars2), - {{cons,Line,MungedExprH,MungedExprT}, Vars3}; -munge_expr({op,Line,Op,ExprL,ExprR}, Vars) -> - {MungedExprL, Vars2} = munge_expr(ExprL, Vars), - {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), - {{op,Line,Op,MungedExprL,MungedExprR}, Vars3}; -munge_expr({op,Line,Op,Expr}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {{op,Line,Op,MungedExpr}, Vars2}; -munge_expr({'catch',Line,Expr}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {{'catch',Line,MungedExpr}, Vars2}; -munge_expr({call,Line1,{remote,Line2,ExprM,ExprF},Exprs}, - Vars) when Vars#vars.is_guard==false-> - {MungedExprM, Vars2} = munge_expr(ExprM, Vars), - {MungedExprF, Vars3} = munge_expr(ExprF, Vars2), - {MungedExprs, Vars4} = munge_exprs(Exprs, Vars3, []), - {{call,Line1,{remote,Line2,MungedExprM,MungedExprF},MungedExprs}, Vars4}; -munge_expr({call,Line1,{remote,_Line2,_ExprM,ExprF},Exprs}, - Vars) when Vars#vars.is_guard==true -> - %% Difference in abstract format after preprocessing: BIF calls in guards - %% are translated to {remote,...} (which is not allowed as source form) - %% NOT NECESSARY FOR Vsn=raw_abstract_v1 - munge_expr({call,Line1,ExprF,Exprs}, Vars); -munge_expr({call,Line,Expr,Exprs}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {MungedExprs, Vars3} = munge_exprs(Exprs, Vars2, []), - {{call,Line,MungedExpr,MungedExprs}, Vars3}; -munge_expr({lc,Line,Expr,LC}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {MungedLC, Vars3} = munge_lc(LC, Vars2, []), - {{lc,Line,MungedExpr,MungedLC}, Vars3}; -munge_expr({block,Line,Body}, Vars) -> - {MungedBody, Vars2} = munge_body(Body, Vars, []), - {{block,Line,MungedBody}, Vars2}; -munge_expr({'if',Line,Clauses}, Vars) -> - {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), - {{'if',Line,MungedClauses}, Vars2}; -munge_expr({'case',Line,Expr,Clauses}, Vars) -> - {MungedExpr,Vars2} = munge_expr(Expr,Vars), - {MungedClauses,Vars3} = munge_clauses(Clauses, Vars2, []), - {{'case',Line,MungedExpr,MungedClauses}, Vars3}; -munge_expr({'receive',Line,Clauses}, Vars) -> - {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), - {{'receive',Line,MungedClauses}, Vars2}; -munge_expr({'receive',Line,Clauses,Expr,Body}, Vars) -> - {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), - {MungedExpr, Vars3} = munge_expr(Expr, Vars2), - {MungedBody, Vars4} = munge_body(Body, Vars3, []), - {{'receive',Line,MungedClauses,MungedExpr,MungedBody}, Vars4}; -munge_expr({'try',Line,Exprs,Clauses,CatchClauses}, Vars) -> - {MungedExprs, Vars1} = munge_exprs(Exprs, Vars, []), - {MungedClauses, Vars2} = munge_clauses(Clauses, Vars1, []), - {MungedCatchClauses, Vars3} = munge_clauses(CatchClauses, Vars2, []), - {{'try',Line,MungedExprs,MungedClauses,MungedCatchClauses}, Vars3}; -%% Difference in abstract format after preprocessing: Funs get an extra -%% element Extra. -%% NOT NECESSARY FOR Vsn=raw_abstract_v1 -munge_expr({'fun',Line,{function,Name,Arity},_Extra}, Vars) -> - {{'fun',Line,{function,Name,Arity}}, Vars}; -munge_expr({'fun',Line,{clauses,Clauses},_Extra}, Vars) -> - {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []), - {{'fun',Line,{clauses,MungedClauses}}, Vars2}; -munge_expr({'fun',Line,{clauses,Clauses}}, Vars) -> - %% Only for Vsn=raw_abstract_v1 - {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []), - {{'fun',Line,{clauses,MungedClauses}}, Vars2}; -munge_expr(Form, Vars) -> % var|char|integer|float|string|atom|nil|bin|eof - {Form, Vars}. - -munge_exprs([Expr|Exprs], Vars, MungedExprs) when Vars#vars.is_guard==true, - is_list(Expr) -> - {MungedExpr, _Vars} = munge_exprs(Expr, Vars, []), - munge_exprs(Exprs, Vars, [MungedExpr|MungedExprs]); -munge_exprs([Expr|Exprs], Vars, MungedExprs) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_exprs(Exprs, Vars2, [MungedExpr|MungedExprs]); -munge_exprs([], Vars, MungedExprs) -> - {lists:reverse(MungedExprs), Vars}. - -munge_lc([{generate,Line,Pattern,Expr}|LC], Vars, MungedLC) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_lc(LC, Vars2, [{generate,Line,Pattern,MungedExpr}|MungedLC]); -munge_lc([Expr|LC], Vars, MungedLC) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_lc(LC, Vars2, [MungedExpr|MungedLC]); -munge_lc([], Vars, MungedLC) -> - {lists:reverse(MungedLC), Vars}. - - - - - - - - - - diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl index 6867e59b60..836443009f 100644 --- a/lib/common_test/test/ct_error_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE.erl @@ -280,41 +280,21 @@ test_events(cfg_error) -> {?eh,tc_start,{cfg_error_2_SUITE,init_per_suite}}, {?eh,tc_done, {cfg_error_2_SUITE,init_per_suite, - {failed,{error,{{badmatch,[1,2]}, - [{cfg_error_2_SUITE,init_per_suite,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,8}]}}}}}, + {failed,{error,{{badmatch,[1,2]},'_'}}}}}, {?eh,tc_auto_skip, {cfg_error_2_SUITE,tc1, {failed,{cfg_error_2_SUITE,init_per_suite, - {'EXIT',{{badmatch,[1,2]}, - [{cfg_error_2_SUITE,init_per_suite,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,8}]}}}}}}, + {'EXIT',{{badmatch,[1,2]},'_'}}}}}}, {?eh,test_stats,{0,0,{0,3}}}, {?eh,tc_auto_skip, {cfg_error_2_SUITE,tc2, {failed,{cfg_error_2_SUITE,init_per_suite, - {'EXIT',{{badmatch,[1,2]}, - [{cfg_error_2_SUITE,init_per_suite,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,8}]}}}}}}, + {'EXIT',{{badmatch,[1,2]},'_'}}}}}}, {?eh,test_stats,{0,0,{0,4}}}, {?eh,tc_auto_skip, {cfg_error_2_SUITE,end_per_suite, {failed,{cfg_error_2_SUITE,init_per_suite, - {'EXIT',{{badmatch,[1,2]}, - [{cfg_error_2_SUITE,init_per_suite,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,8}]}}}}}}, + {'EXIT',{{badmatch,[1,2]},'_'}}}}}}, {?eh,tc_start,{cfg_error_3_SUITE,init_per_suite}}, {?eh,tc_done, @@ -373,12 +353,7 @@ test_events(cfg_error) -> {?eh,tc_done,{cfg_error_6_SUITE,{end_per_group,g1,[]},ok}}], {?eh,tc_start,{cfg_error_6_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_6_SUITE,end_per_suite, - {failed,{error,{{badmatch,[1,2]}, - [{cfg_error_6_SUITE,end_per_suite,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,8}]}}}}}, + {failed,{error,{{badmatch,[1,2]},'_'}}}}}, {?eh,tc_start,{cfg_error_7_SUITE,init_per_suite}}, {?eh,tc_done,{cfg_error_7_SUITE,init_per_suite,ok}}, @@ -427,31 +402,16 @@ test_events(cfg_error) -> [{?eh,tc_start,{cfg_error_8_SUITE,{init_per_group,g3,[]}}}, {?eh,tc_done, {cfg_error_8_SUITE,{init_per_group,g3,[]}, - {failed,{error,{{badmatch,42}, - [{cfg_error_8_SUITE,init_per_group,2}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,8}]}}}}}, + {failed,{error,{{badmatch,42},'_'}}}}}, {?eh,tc_auto_skip, {cfg_error_8_SUITE,tc1, {failed,{cfg_error_8_SUITE,init_per_group, - {'EXIT',{{badmatch,42}, - [{cfg_error_8_SUITE,init_per_group,2}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,8}]}}}}}}, + {'EXIT',{{badmatch,42},'_'}}}}}}, {?eh,test_stats,{4,0,{0,13}}}, {?eh,tc_auto_skip, {cfg_error_8_SUITE,end_per_group, {failed,{cfg_error_8_SUITE,init_per_group, - {'EXIT',{{badmatch,42}, - [{cfg_error_8_SUITE,init_per_group,2}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,8}]}}}}}}], + {'EXIT',{{badmatch,42},'_'}}}}}}], [{?eh,tc_start,{cfg_error_8_SUITE,{init_per_group,g4,[]}}}, {?eh,tc_done,{cfg_error_8_SUITE,{init_per_group,g4,[]},ok}}, @@ -520,12 +480,7 @@ test_events(cfg_error) -> {?eh,tc_start,{cfg_error_9_SUITE,tc3}}, {?eh,tc_done,{cfg_error_9_SUITE,tc3, {skipped,{failed,{cfg_error_9_SUITE,init_per_testcase, - {{badmatch,undefined}, - [{cfg_error_9_SUITE,init_per_testcase,2}, - {test_server,my_apply,3}, - {test_server,init_per_testcase,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,8}]}}}}}}, + {{badmatch,undefined},'_'}}}}}}, {?eh,test_stats,{9,0,{0,17}}}, {?eh,tc_start,{cfg_error_9_SUITE,tc4}}, {?eh,tc_done, @@ -640,13 +595,7 @@ test_events(lib_error) -> {?eh,tc_done, {lib_error_1_SUITE,lines_error,{failed, {error, - {{badmatch,[1,2]}, - [{lib_lines,do_error,0}, - {lib_error_1_SUITE,lines_error,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,8}]}}}}}, + {{badmatch,[1,2]},'_'}}}}}, {?eh,test_stats,{0,1,{0,0}}}, {?eh,tc_start,{lib_error_1_SUITE,lines_exit}}, {?eh,tc_done, @@ -665,13 +614,7 @@ test_events(lib_error) -> {?eh,tc_done, {lib_error_1_SUITE,no_lines_error,{failed, {error, - {{badmatch,[1,2]}, - [{lib_no_lines,do_error,0}, - {lib_error_1_SUITE,no_lines_error,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,8}]}}}}}, + {{badmatch,[1,2]},'_'}}}}}, {?eh,test_stats,{0,5,{0,0}}}, {?eh,tc_start,{lib_error_1_SUITE,no_lines_exit}}, {?eh,tc_done, diff --git a/lib/common_test/test/ct_repeat_1_SUITE.erl b/lib/common_test/test/ct_repeat_1_SUITE.erl index 4e842bd6d6..090002d0c2 100644 --- a/lib/common_test/test/ct_repeat_1_SUITE.erl +++ b/lib/common_test/test/ct_repeat_1_SUITE.erl @@ -560,12 +560,7 @@ test_events(repeat_cs_until_any_fail) -> {repeat_1_SUITE,tc_fail_1, {failed, {error, - {{badmatch,2}, - [{repeat_1_SUITE,tc_fail_1,1}, - {test_server,my_apply,3}, - {test_server,ts_tc,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,8}]}}}}}, + {{badmatch,2},'_'}}}}}, {?eh,test_stats,{5,2,{0,0}}}, {?eh,tc_start,{repeat_1_SUITE,tc_fail_2}}, {?eh,tc_done, diff --git a/lib/common_test/test/ct_skip_SUITE.erl b/lib/common_test/test/ct_skip_SUITE.erl index 4ba4479208..b8be55f43a 100644 --- a/lib/common_test/test/ct_skip_SUITE.erl +++ b/lib/common_test/test/ct_skip_SUITE.erl @@ -197,7 +197,7 @@ test_events(auto_skip) -> {?eh,tc_done, {auto_skip_3_SUITE,tc1, {skipped,{failed,{auto_skip_3_SUITE,init_per_testcase, - {init_per_testcase,tc1,failed}}}}}}, + {{init_per_testcase,tc1,failed},'_'}}}}}}, {?eh,test_stats,{0,0,{0,4}}}, {?eh,tc_start,{auto_skip_3_SUITE,tc2}}, {?eh,tc_done,{auto_skip_3_SUITE,tc2,ok}}, @@ -364,12 +364,7 @@ test_events(auto_skip) -> {?eh,tc_done, {auto_skip_9_SUITE,tc8, {skipped,{failed,{auto_skip_9_SUITE,init_per_testcase, - {{badmatch,undefined}, - [{auto_skip_9_SUITE,init_per_testcase,2}, - {test_server,my_apply,3}, - {test_server,init_per_testcase,3}, - {test_server,run_test_case_eval1,6}, - {test_server,run_test_case_eval,8}]}}}}}}, + {{badmatch,undefined},'_'}}}}}}, {?eh,tc_start, {auto_skip_9_SUITE,{end_per_group,g5,[parallel]}}}, {?eh,tc_done, diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index 830c89ae84..522c1dc411 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -395,6 +395,14 @@ module.beam: module.erl \ <code>-compile({no_auto_import,[error/1]}).</code> </item> + <tag><c>no_line_info</c></tag> + + <item> + <p>Omit line number information in order to produce a slightly + smaller output file. + </p> + </item> + </taglist> <p>If warnings are turned on (the <c>report_warnings</c> option diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl index 89d64834cf..6e63c4d0f2 100644 --- a/lib/compiler/src/beam_asm.erl +++ b/lib/compiler/src/beam_asm.erl @@ -23,7 +23,7 @@ -export([module/4]). -export([encode/2]). --import(lists, [map/2,member/2,keymember/3,duplicate/2]). +-import(lists, [map/2,member/2,keymember/3,duplicate/2,splitwith/2]). -include("beam_opcodes.hrl"). module(Code, Abst, SourceFile, Opts) -> @@ -31,22 +31,20 @@ module(Code, Abst, SourceFile, Opts) -> assemble({Mod,Exp,Attr0,Asm0,NumLabels}, Abst, SourceFile, Opts) -> {1,Dict0} = beam_dict:atom(Mod, beam_dict:new()), + {0,Dict1} = beam_dict:fname(atom_to_list(Mod) ++ ".erl", Dict0), NumFuncs = length(Asm0), {Asm,Attr} = on_load(Asm0, Attr0), - {Code,Dict1} = assemble_1(Asm, Exp, Dict0, []), - build_file(Code, Attr, Dict1, NumLabels, NumFuncs, Abst, SourceFile, Opts). + {Code,Dict2} = assemble_1(Asm, Exp, Dict1, []), + build_file(Code, Attr, Dict2, NumLabels, NumFuncs, Abst, SourceFile, Opts). on_load(Fs0, Attr0) -> case proplists:get_value(on_load, Attr0) of undefined -> {Fs0,Attr0}; [{Name,0}] -> - Fs = map(fun({function,N,0,Entry,Asm0}) when N =:= Name -> - [{label,_}=L, - {func_info,_,_,_}=Fi, - {label,_}=E|Asm1] = Asm0, - Asm = [L,Fi,E,on_load|Asm1], - {function,N,0,Entry,Asm}; + Fs = map(fun({function,N,0,Entry,Is0}) when N =:= Name -> + Is = insert_on_load_instruction(Is0, Entry), + {function,N,0,Entry,Is}; (F) -> F end, Fs0), @@ -54,6 +52,13 @@ on_load(Fs0, Attr0) -> {Fs,Attr} end. +insert_on_load_instruction(Is0, Entry) -> + {Bef,[{label,Entry}=El|Is]} = + splitwith(fun({label,L}) when L =:= Entry -> false; + (_) -> true + end, Is0), + Bef ++ [El,on_load|Is]. + assemble_1([{function,Name,Arity,Entry,Asm}|T], Exp, Dict0, Acc) -> Dict1 = case member({Name,Arity}, Exp) of true -> @@ -132,7 +137,10 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> LitTab = iolist_to_binary(zlib:compress(LitTab2)), chunk(<<"LitT">>, <<(byte_size(LitTab2)):32>>, LitTab) end, + + %% Create the line chunk. + LineChunk = chunk(<<"Line">>, build_line_table(Dict)), %% Create the attributes and compile info chunks. @@ -150,8 +158,11 @@ build_file(Code, Attr, Dict, NumLabels, NumFuncs, Abst, SourceFile, Opts) -> %% Create IFF chunk. Chunks = case member(slim, Opts) of - true -> [Essentials,AttrChunk,AbstChunk]; - false -> [Essentials,LocChunk,AttrChunk,CompileChunk,AbstChunk] + true -> + [Essentials,AttrChunk,AbstChunk]; + false -> + [Essentials,LocChunk,AttrChunk, + CompileChunk,AbstChunk,LineChunk] end, build_form(<<"BEAM">>, Chunks). @@ -201,6 +212,31 @@ build_attributes(Opts, SourceFile, Attr, Essentials) -> Compile = [{options,Opts},{version,?COMPILER_VSN}|Misc], {term_to_binary(calc_vsn(Attr, Essentials)),term_to_binary(Compile)}. +build_line_table(Dict) -> + {NumLineInstrs,NumFnames0,Fnames0,NumLines,Lines0} = + beam_dict:line_table(Dict), + NumFnames = NumFnames0 - 1, + [_|Fnames1] = Fnames0, + Fnames2 = [unicode:characters_to_binary(F) || F <- Fnames1], + Fnames = << <<(byte_size(F)):16,F/binary>> || F <- Fnames2 >>, + Lines1 = encode_line_items(Lines0, 0), + Lines = iolist_to_binary(Lines1), + Ver = 0, + Bits = 0, + <<Ver:32,Bits:32,NumLineInstrs:32,NumLines:32,NumFnames:32, + Lines/binary,Fnames/binary>>. + +%% encode_line_items([{FnameIndex,Line}], PrevFnameIndex) +%% Encode the line items compactly. Tag the FnameIndex with +%% an 'a' tag (atom) and only include it when it has changed. +%% Tag the line numbers with an 'i' (integer) tag. + +encode_line_items([{F,L}|T], F) -> + [encode(?tag_i, L)|encode_line_items(T, F)]; +encode_line_items([{F,L}|T], _) -> + [encode(?tag_a, F),encode(?tag_i, L)|encode_line_items(T, F)]; +encode_line_items([], _) -> []. + %% %% If the attributes contains no 'vsn' attribute, we'll insert one %% with an MD5 "checksum" calculated on the code as its value. @@ -243,6 +279,9 @@ bif_type(_, 2) -> bif2. make_op({'%',_}, Dict) -> {[],Dict}; +make_op({line,Location}, Dict0) -> + {Index,Dict} = beam_dict:line(Location, Dict0), + encode_op(line, [Index], Dict); make_op({bif, Bif, {f,_}, [], Dest}, Dict) -> %% BIFs without arguments cannot fail. encode_op(bif0, [{extfunc, erlang, Bif, 0}, Dest], Dict); diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index c45874597a..432d1e7eea 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -36,13 +36,14 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> %% Collect basic blocks and optimize them. Is2 = blockify(Is1), - Is3 = move_allocates(Is2), - Is4 = beam_utils:live_opt(Is3), - Is5 = opt_blocks(Is4), - Is6 = beam_utils:delete_live_annos(Is5), + Is3 = embed_lines(Is2), + Is4 = move_allocates(Is3), + Is5 = beam_utils:live_opt(Is4), + Is6 = opt_blocks(Is5), + Is7 = beam_utils:delete_live_annos(Is6), %% Optimize bit syntax. - {Is,Lc} = bsm_opt(Is6, Lc0), + {Is,Lc} = bsm_opt(Is7, Lc0), %% Done. {{function,Name,Arity,CLabel,Is},Lc} @@ -148,6 +149,24 @@ collect(remove_message) -> {set,[],[],remove_message}; collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; collect(_) -> error. +%% embed_lines([Instruction]) -> [Instruction] +%% Combine blocks that would be split by line/1 instructions. +%% Also move a line instruction before a block into the block, +%% but leave the line/1 instruction after a block outside. + +embed_lines(Is) -> + embed_lines(reverse(Is), []). + +embed_lines([{block,B2},{line,_}=Line,{block,B1}|T], Acc) -> + B = {block,B1++[{set,[],[],Line}]++B2}, + embed_lines([B|T], Acc); +embed_lines([{block,B1},{line,_}=Line|T], Acc) -> + B = {block,[{set,[],[],Line}|B1]}, + embed_lines([B|T], Acc); +embed_lines([I|Is], Acc) -> + embed_lines(Is, [I|Acc]); +embed_lines([], Acc) -> Acc. + opt_blocks([{block,Bl0}|Is]) -> %% The live annotation at the beginning is not useful. [{'%live',_}|Bl] = Bl0, @@ -225,10 +244,12 @@ opt([{set,[Dst],As,{bif,Bif,Fail}}=I1, RevBif -> [{set,[Dst],As,{bif,RevBif,Fail}}|opt(Is)] end; opt([{set,[X],[X],move}|Is]) -> opt(Is); -opt([{set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1, +opt([{set,_,_,{line,_}}=Line1, + {set,[D1],[{integer,Idx1},Reg],{bif,element,{f,0}}}=I1, + {set,_,_,{line,_}}=Line2, {set,[D2],[{integer,Idx2},Reg],{bif,element,{f,0}}}=I2|Is]) when Idx1 < Idx2, D1 =/= D2, D1 =/= Reg, D2 =/= Reg -> - opt([I2,I1|Is]); + opt([Line2,I2,Line1,I1|Is]); opt([{set,Ds0,Ss,Op}|Is0]) -> {Ds,Is} = opt_moves(Ds0, Is0), [{set,Ds,Ss,Op}|opt(Is)]; diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 415864b8e9..1217f7f777 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -20,7 +20,7 @@ -module(beam_bsm). -export([module/2,format_error/1]). --import(lists, [member/2,foldl/3,reverse/1,sort/1,all/2]). +-import(lists, [member/2,foldl/3,reverse/1,sort/1,all/2,dropwhile/2]). %%% %%% We optimize bit syntax matching where the tail end of a binary is @@ -376,6 +376,8 @@ btb_reaches_match_2([{func_info,_,_,Arity}=I|_], Regs0, D) -> [] -> D; _ -> {binary_used_in,I} end; +btb_reaches_match_2([{line,_}|Is], Regs, D) -> + btb_reaches_match_1(Is, Regs, D); btb_reaches_match_2([I|_], Regs, _) -> btb_error({btb_context_regs(Regs),I,not_handled}). @@ -580,7 +582,10 @@ btb_index(Fs) -> btb_index_1(Fs, []). btb_index_1([{function,_,_,Entry,Is0}|Fs], Acc0) -> - [{label,_},{func_info,_,_,_},{label,Entry}|Is] = Is0, + [{label,Entry}|Is] = + dropwhile(fun({label,L}) when L =:= Entry -> false; + (_) -> true + end, Is0), Acc = btb_index_2(Is, Entry, false, Acc0), btb_index_1(Fs, Acc); btb_index_1([], Acc) -> gb_trees:from_orddict(sort(Acc)). diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index 64c93e11f7..a7994ab3b3 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2009. All Rights Reserved. +%% Copyright Ericsson AB 2000-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -23,9 +23,9 @@ -export([module/2]). -export([bs_clean_saves/1]). -export([clean_labels/1]). --import(lists, [map/2,foldl/3,reverse/1]). +-import(lists, [map/2,foldl/3,reverse/1,filter/2]). -module({Mod,Exp,Attr,Fs0,_}, _Opt) -> +module({Mod,Exp,Attr,Fs0,_}, Opts) -> Order = [Lbl || {function,_,_,Lbl,_} <- Fs0], All = foldl(fun({function,_,_,Lbl,_}=Func,D) -> dict:store(Lbl, Func, D) end, dict:new(), Fs0), @@ -33,7 +33,8 @@ module({Mod,Exp,Attr,Fs0,_}, _Opt) -> Used = find_all_used(WorkList, All, sets:from_list(WorkList)), Fs1 = remove_unused(Order, Used, All), {Fs2,Lc} = clean_labels(Fs1), - Fs = bs_fix(Fs2), + Fs3 = bs_fix(Fs2), + Fs = maybe_remove_lines(Fs3, Opts), {ok,{Mod,Exp,Attr,Fs,Lc}}. %% Remove all bs_save2/2 instructions not referenced by a bs_restore2/2. @@ -375,3 +376,20 @@ bs_clean_saves_1([{bs_save2,_,{_,_}=SavePoint}=I|Is], Needed, Acc) -> bs_clean_saves_1([I|Is], Needed, Acc) -> bs_clean_saves_1(Is, Needed, [I|Acc]); bs_clean_saves_1([], _, Acc) -> reverse(Acc). + +%%% +%%% Remove line instructions if requested. +%%% + +maybe_remove_lines(Fs, Opts) -> + case proplists:get_bool(no_line_info, Opts) of + false -> Fs; + true -> remove_lines(Fs) + end. + +remove_lines([{function,N,A,Lbl,Is0}|T]) -> + Is = filter(fun({line,_}) -> false; + (_) -> true + end, Is0), + [{function,N,A,Lbl,Is}|remove_lines(T)]; +remove_lines([]) -> []. diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index 1365f3d20a..9f81a6ab43 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -144,9 +144,9 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> %% Initialize label information with the code %% for the func_info label. Without it, a register %% may seem to be live when it is not. - [{label,L},{func_info,_,_,_}=FI|_] = Is1, + [{label,L}|FiIs] = Is1, D0 = beam_utils:empty_label_index(), - D = beam_utils:index_label(L, [FI], D0), + D = beam_utils:index_label(L, FiIs, D0), %% Optimize away dead code. {Is2,Lc} = forward(Is1, Lc0), @@ -185,6 +185,8 @@ split_block([{set,[R],As,{alloc,Live,{gc_bif,N,{f,Lbl}=Fail}}}|Is], Bl, Acc) split_block(Is, [], [{gc_bif,N,Fail,Live,As,R}|make_block(Bl, Acc)]); split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); +split_block([{set,[],[],{line,_}=Line}|Is], Bl, Acc) -> + split_block(Is, [], [Line|make_block(Bl, Acc)]); split_block([I|Is], Bl, Acc) -> split_block(Is, [I|Bl], Acc); split_block([], Bl, Acc) -> make_block(Bl, Acc). @@ -406,7 +408,7 @@ backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) -> end, I = {test,Op,{f,To},Live,Ops0,Dst}, backward(Is, D, [I|Acc]); -backward([{kill,_}=I|Is], D, [Exit|_]=Acc) -> +backward([{kill,_}=I|Is], D, [{line,_},Exit|_]=Acc) -> case beam_jump:is_exit_instruction(Exit) of false -> backward(Is, D, [I|Acc]); true -> backward(Is, D, Acc) @@ -471,7 +473,7 @@ shortcut_fail_label(To0, Reg, Val, D) -> shortcut_boolean_label(To0, Reg, Bool0, D) when is_boolean(Bool0) -> case beam_utils:code_at(To0, D) of - [{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] -> + [{line,_},{bif,'not',_,[Reg],Reg},{jump,{f,To}}|_] -> Bool = not Bool0, {shortcut_select_label(To, Reg, Bool, D),Bool}; _ -> diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl index c50ed28aa9..ee76623976 100644 --- a/lib/compiler/src/beam_dict.erl +++ b/lib/compiler/src/beam_dict.erl @@ -22,9 +22,10 @@ -export([new/0,opcode/2,highest_opcode/1, atom/2,local/4,export/4,import/4, - string/2,lambda/5,literal/2, + string/2,lambda/5,literal/2,line/2,fname/2, atom_table/1,local_table/1,export_table/1,import_table/1, - string_table/1,lambda_table/1,literal_table/1]). + string_table/1,lambda_table/1,literal_table/1, + line_table/1]). -type label() :: non_neg_integer(). @@ -36,6 +37,9 @@ strings = <<>> :: binary(), %String pool lambdas = [], %[{...}] literals = dict:new() :: dict(), %Format: {Literal,Number} + fnames = gb_trees:empty() :: gb_tree(), %{Name,Index} + lines = gb_trees:empty() :: gb_tree(), %{{Fname,Line},Index} + num_lines = 0 :: non_neg_integer(), %Number of line instructions next_import = 0 :: non_neg_integer(), string_offset = 0 :: non_neg_integer(), next_literal = 0 :: non_neg_integer(), @@ -152,6 +156,36 @@ literal(Lit, #asm{literals=Tab0,next_literal=NextIndex}=Dict) -> {NextIndex,Dict#asm{literals=Tab,next_literal=NextIndex+1}} end. +%% Returns the index for a line instruction (adding information +%% to the location information table). +-spec line(list(), bdict()) -> {non_neg_integer(), bdict()}. + +line([], #asm{num_lines=N}=Dict) -> + %% No location available. Return the special pre-defined + %% index 0. + {0,Dict#asm{num_lines=N+1}}; +line([{location,Name,Line}], #asm{lines=Lines0,num_lines=N}=Dict0) -> + {FnameIndex,Dict1} = fname(Name, Dict0), + case gb_trees:lookup({FnameIndex,Line}, Lines0) of + {value,Index} -> + {Index,Dict1#asm{num_lines=N+1}}; + none -> + Index = gb_trees:size(Lines0) + 1, + Lines = gb_trees:insert({FnameIndex,Line}, Index, Lines0), + Dict = Dict1#asm{lines=Lines,num_lines=N+1}, + {Index,Dict} + end. + +fname(Name, #asm{fnames=Fnames0}=Dict) -> + case gb_trees:lookup(Name, Fnames0) of + {value,Index} -> + {Index,Dict}; + none -> + Index = gb_trees:size(Fnames0), + Fnames = gb_trees:insert(Name, Index, Fnames0), + {Index,Dict#asm{fnames=Fnames}} + end. + %% Returns the atom table. %% atom_table(Dict) -> {LastIndex,[Length,AtomString...]} -spec atom_table(bdict()) -> {non_neg_integer(), [[non_neg_integer(),...]]}. @@ -219,6 +253,21 @@ literal_table(#asm{literals=Tab,next_literal=NumLiterals}) -> my_term_to_binary(Term) -> term_to_binary(Term, [{minor_version,1}]). +%% Return the line table. +-spec line_table(bdict()) -> + {non_neg_integer(), %Number of line instructions. + non_neg_integer(),[string()], + non_neg_integer(),[{non_neg_integer(),non_neg_integer()}]}. + +line_table(#asm{fnames=Fnames0,lines=Lines0,num_lines=NumLineInstrs}) -> + NumFnames = gb_trees:size(Fnames0), + Fnames1 = lists:keysort(2, gb_trees:to_list(Fnames0)), + Fnames = [Name || {Name,_} <- Fnames1], + NumLines = gb_trees:size(Lines0), + Lines1 = lists:keysort(2, gb_trees:to_list(Lines0)), + Lines = [L || {L,_} <- Lines1], + {NumLineInstrs,NumFnames,Fnames,NumLines,Lines}. + %% Search for binary string Str in the binary string pool Pool. %% old_string(Str, Pool) -> none | Index -spec old_string(binary(), binary()) -> 'none' | pos_integer(). diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index bb62bb04b3..29a634b18e 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -296,6 +296,8 @@ get_function_chunks(Code) -> labels_r([], R) -> {R, []}; labels_r([{label,_}=I|Is], R) -> labels_r(Is, [I|R]); +labels_r([{line,_}=I|Is], R) -> + labels_r(Is, [I|R]); labels_r(Is, R) -> {R, Is}. get_funs({[],[]}) -> []; @@ -335,20 +337,17 @@ local_labels(Funs) -> local_labels_1(function__code(F), R) end, [], Funs)). -%% The first clause below attempts to provide some (limited form of) -%% backwards compatibility; it is not needed for .beam files generated -%% by the R8 compiler. The clause should one fine day be taken out. -local_labels_1([{label,_}|[{label,_}|_]=Code], R) -> - local_labels_1(Code, R); -local_labels_1([{label,_},{func_info,{atom,M},{atom,F},A}|Code], R) - when is_atom(M), is_atom(F) -> - local_labels_2(Code, R, M, F, A); -local_labels_1(Code, _) -> - ?exit({'local_labels: no label in code',Code}). +local_labels_1(Code0, R) -> + Code1 = lists:dropwhile(fun({label,_}) -> true; + ({line,_}) -> true; + ({func_info,_,_,_}) -> false + end, Code0), + [{func_info,{atom,M},{atom,F},A}|Code] = Code1, + local_labels_2(Code, R, {M,F,A}). -local_labels_2([{label,[{u,L}]}|Code], R, M, F, A) -> - local_labels_2(Code, [{L,{M,F,A}}|R], M, F, A); -local_labels_2(_, R, _, _, _) -> R. +local_labels_2([{label,[{u,L}]}|Code], R, MFA) -> + local_labels_2(Code, [{L,MFA}|R], MFA); +local_labels_2(_, R, _) -> R. %%----------------------------------------------------------------------- %% Disassembles a single BEAM instruction; most instructions are handled @@ -1105,6 +1104,12 @@ resolve_inst({recv_set,[Lbl]},_,_,_) -> {recv_set,Lbl}; %% +%% R15A. +%% +resolve_inst({line,[Index]},_,_,_) -> + {line,resolve_arg(Index)}; + +%% %% Catches instructions that are not yet handled. %% resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}). diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 3cab55c4cb..537f8ca81b 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -169,7 +169,7 @@ share_1([{label,L}=Lbl|Is], Dict0, Seq, Acc) -> share_1(Is, Dict0, [], [Lbl,{jump,{f,Label}}|Acc]) end; share_1([{func_info,_,_,_}=I|Is], _, [], Acc) -> - Is++[I|Acc]; + reverse(Is, [I|Acc]); share_1([I|Is], Dict, Seq, Acc) -> case is_unreachable_after(I) of false -> @@ -206,25 +206,35 @@ is_label(_) -> false. move(Is) -> move_1(Is, [], []). -move_1([I|Is], End, Acc) -> +move_1([I|Is], End0, Acc0) -> case is_exit_instruction(I) of - false -> move_1(Is, End, [I|Acc]); - true -> move_2(I, Is, End, Acc) + false -> + move_1(Is, End0, [I|Acc0]); + true -> + case extract_seq(Acc0, [I|End0]) of + no -> + move_1(Is, End0, [I|Acc0]); + {yes,End,Acc} -> + move_1(Is, End, Acc) + end end; -move_1([], End, Acc) -> - reverse(Acc, reverse(End)). - -move_2(Exit, Is, End, [{block,_},{label,_},{func_info,_,_,_}|_]=Acc) -> - move_1(Is, End, [Exit|Acc]); -move_2(Exit, Is, End, [{block,_}=Blk,{label,_}=Lbl,Unreachable|More]) -> - move_1([Unreachable|Is], [Exit,Blk,Lbl|End], More); -move_2(Exit, Is, End, [{bs_context_to_binary,_}=Bs,{label,_}=Lbl, - Unreachable|More]) -> - move_1([Unreachable|Is], [Exit,Bs,Lbl|End], More); -move_2(Exit, Is, End, [{label,_}=Lbl,Unreachable|More]) -> - move_1([Unreachable|Is], [Exit,Lbl|End], More); -move_2(Exit, Is, End, Acc) -> - move_1(Is, End, [Exit|Acc]). +move_1([], End, Acc) -> reverse(Acc, End). + +extract_seq([{line,_}=Line|Is], Acc) -> + extract_seq(Is, [Line|Acc]); +extract_seq([{block,_}=Bl|Is], Acc) -> + extract_seq_1(Is, [Bl|Acc]); +extract_seq([{label,_}|_]=Is, Acc) -> + extract_seq_1(Is, Acc); +extract_seq(_, _) -> no. + +extract_seq_1([{line,_}=Line|Is], Acc) -> + extract_seq_1(Is, [Line|Acc]); +extract_seq_1([{label,_},{func_info,_,_,_}|_], _) -> + no; +extract_seq_1([{label,_}=Lbl|Is], Acc) -> + {yes,[Lbl|Acc],Is}; +extract_seq_1(_, _) -> no. %%% %%% (3) (4) (5) (6) Jump and unreachable code optimizations. @@ -454,6 +464,7 @@ is_label_used_in_2({set,_,_,Info}, Lbl) -> {put_tuple,_} -> false; {get_tuple_element,_} -> false; {set_tuple_element,_} -> false; + {line,_} -> false; _ when is_atom(Info) -> false end. @@ -487,6 +498,8 @@ rem_unused([], _, Acc) -> reverse(Acc). initial_labels(Is) -> initial_labels(Is, []). +initial_labels([{line,_}|Is], Acc) -> + initial_labels(Is, Acc); initial_labels([{label,Lbl}|Is], Acc) -> initial_labels(Is, [Lbl|Acc]); initial_labels([{func_info,_,_,_},{label,Lbl}|_], Acc) -> diff --git a/lib/compiler/src/beam_listing.erl b/lib/compiler/src/beam_listing.erl index be7b14c3dd..2941f6135c 100644 --- a/lib/compiler/src/beam_listing.erl +++ b/lib/compiler/src/beam_listing.erl @@ -61,7 +61,7 @@ print_op(Stream, Label) when element(1, Label) == label -> print_op(Stream, Op) -> io:format(Stream, " ~p.\n", [Op]). -function(File, {function,Name,Arity,Args,Body,Vdb}) -> +function(File, {function,Name,Arity,Args,Body,Vdb,_Anno}) -> io:nl(File), io:format(File, "function ~p/~p.\n", [Name,Arity]), io:format(File, " ~p.\n", [Args]), diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl index 9ed44ad5d7..c483d85a97 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -175,6 +175,8 @@ opt_update_regs({label,Lbl}, R, L) -> end; opt_update_regs({try_end,_}, R, L) -> {R,L}; +opt_update_regs({line,_}, R, L) -> + {R,L}; opt_update_regs(_I, _R, L) -> %% Unrecognized instruction. Abort the search. {regs_init(),L}. diff --git a/lib/compiler/src/beam_trim.erl b/lib/compiler/src/beam_trim.erl index 790aba0a9a..25e6ffbb73 100644 --- a/lib/compiler/src/beam_trim.erl +++ b/lib/compiler/src/beam_trim.erl @@ -222,7 +222,9 @@ remap([{call_last,Ar,Name,N}|Is], Map, Acc) -> reverse(Acc, [I|Is]); remap([{call_ext_last,Ar,Name,N}|Is], Map, Acc) -> I = {call_ext_last,Ar,Name,Map({frame_size,N})}, - reverse(Acc, [I|Is]). + reverse(Acc, [I|Is]); +remap([{line,_}=I|Is], Map, Acc) -> + remap(Is, Map, [I|Acc]). remap_block([{set,Ds0,Ss0,Info}|Is], Map, Acc) -> Ds = [Map(D) || D <- Ds0], @@ -230,14 +232,15 @@ remap_block([{set,Ds0,Ss0,Info}|Is], Map, Acc) -> remap_block(Is, Map, [{set,Ds,Ss,Info}|Acc]); remap_block([], _, Acc) -> reverse(Acc). -safe_labels([{label,L},{badmatch,{Tag,_}}|Is], Acc) when Tag =/= y -> +safe_labels([{label,L},{line,_},{badmatch,{Tag,_}}|Is], Acc) when Tag =/= y -> safe_labels(Is, [L|Acc]); -safe_labels([{label,L},{case_end,{Tag,_}}|Is], Acc) when Tag =/= y -> +safe_labels([{label,L},{line,_},{case_end,{Tag,_}}|Is], Acc) when Tag =/= y -> safe_labels(Is, [L|Acc]); -safe_labels([{label,L},if_end|Is], Acc) -> +safe_labels([{label,L},{line,_},if_end|Is], Acc) -> safe_labels(Is, [L|Acc]); safe_labels([{label,L}, {block,[{set,[{x,0}],[{Tag,_}],move}]}, + {line,_}, {call_ext,1,{extfunc,erlang,error,1}}|Is], Acc) when Tag =/= y -> safe_labels(Is, [L|Acc]); safe_labels([_|Is], Acc) -> @@ -321,6 +324,8 @@ frame_size([{make_fun2,_,_,_,_}|Is], Safe) -> frame_size([{deallocate,N}|_], _) -> N; frame_size([{call_last,_,_,N}|_], _) -> N; frame_size([{call_ext_last,_,_,N}|_], _) -> N; +frame_size([{line,_}|Is], Safe) -> + frame_size(Is, Safe); frame_size([_|_], _) -> throw(not_possible). frame_size_branch(0, Is, Safe) -> diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index f83f73b224..7fdb8d072a 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -400,6 +400,7 @@ update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts); +update({line,_}, Ts) -> Ts; %% The instruction is unknown. Kill all information. update(_I, _Ts) -> tdb_new(). diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 45cdf8a659..f281ad5eac 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -26,7 +26,7 @@ code_at/2,bif_to_test/3,is_pure_test/1, live_opt/1,delete_live_annos/1,combine_heap_needs/2]). --import(lists, [member/2,sort/1,reverse/1]). +-import(lists, [member/2,sort/1,reverse/1,splitwith/2]). -record(live, {bl, %Block check fun. @@ -195,10 +195,14 @@ is_pure_test({test,Op,_,Ops}) -> %% Also insert {'%live',Live} annotations at the beginning %% and end of each block. %% -live_opt([{label,Fail}=I1, - {func_info,_,_,Live}=I2|Is]) -> +live_opt(Is0) -> + {[{label,Fail}|_]=Bef,[Fi|Is]} = + splitwith(fun({func_info,_,_,_}) -> false; + (_) -> true + end, Is0), + {func_info,_,_,Live} = Fi, D = gb_trees:insert(Fail, live_call(Live), gb_trees:empty()), - [I1,I2|live_opt(reverse(Is), 0, D, [])]. + Bef ++ [Fi|live_opt(reverse(Is), 0, D, [])]. %% delete_live_annos([Instruction]) -> [Instruction]. @@ -499,6 +503,8 @@ check_liveness(R, [{loop_rec,{f,_},{x,0}}|_], St) -> end; check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) -> check_liveness_at(R, Fail, St); +check_liveness(R, [{line,_}|Is], St) -> + check_liveness(R, Is, St); check_liveness(_R, Is, St) when is_list(Is) -> %% case Is of %% [I|_] -> @@ -799,6 +805,8 @@ live_opt([{wait,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{wait_timeout,_,{Tag,_}}=I|Is], Regs, D, Acc) when Tag =/= x -> live_opt(Is, Regs, D, [I|Acc]); +live_opt([{line,_}=I|Is], Regs, D, Acc) -> + live_opt(Is, Regs, D, [I|Acc]); %% The following instructions can occur if the "compilation" has been %% started from a .S file using the 'asm' option. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index fb267b35b6..fe3b1680d9 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -166,12 +166,17 @@ validate(Module, Fs) -> Ft = index_bs_start_match(Fs, []), validate_0(Module, Fs, Ft). -index_bs_start_match([{function,_,_,Entry,Code}|Fs], Acc0) -> +index_bs_start_match([{function,_,_,Entry,Code0}|Fs], Acc0) -> + Code = dropwhile(fun({label,L}) when L =:= Entry -> false; + (_) -> true + end, Code0), case Code of - [_,_,{label,Entry}|Is] -> + [{label,Entry}|Is] -> Acc = index_bs_start_match_1(Is, Entry, Acc0), index_bs_start_match(Fs, Acc); _ -> + %% Something serious is wrong. Ignore it for now. + %% It will be detected and diagnosed later. index_bs_start_match(Fs, Acc0) end; index_bs_start_match([], Acc) -> @@ -292,6 +297,8 @@ labels(Is) -> labels_1([{label,L}|Is], R) -> labels_1(Is, [L|R]); +labels_1([{line,_}|Is], R) -> + labels_1(Is, R); labels_1(Is, R) -> {lists:reverse(R),Is}. @@ -433,6 +440,8 @@ valfun_1(remove_message, Vst) -> Vst; valfun_1({'%',_}, Vst) -> Vst; +valfun_1({line,_}, Vst) -> + Vst; %% Exception generating calls valfun_1({call_ext,Live,Func}=I, Vst) -> case return_type(Func, Vst) of @@ -870,6 +879,8 @@ val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) -> error(illegal_context_for_set_tuple_element); val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=true}}=Vst) -> Vst; +val_dsetel({line,_}, Vst) -> + Vst; val_dsetel(_, #vst{current=#st{setelem=true}=St}=Vst) -> Vst#vst{current=St#st{setelem=false}}; val_dsetel(_, Vst) -> Vst. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index e46c667e47..15849957e7 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -172,9 +172,9 @@ expand_opt(report, Os) -> expand_opt(return, Os) -> [return_errors,return_warnings|Os]; expand_opt(r12, Os) -> - [no_recv_opt|Os]; + [no_recv_opt,no_line_info|Os]; expand_opt(r13, Os) -> - [no_recv_opt|Os]; + [no_recv_opt,no_line_info|Os]; expand_opt({debug_info_key,_}=O, Os) -> [encrypt_debug_info,O|Os]; expand_opt(no_float_opt, Os) -> @@ -1438,6 +1438,8 @@ iofile(File) when is_atom(File) -> iofile(File) -> {filename:dirname(File), filename:basename(File, ".erl")}. +erlfile(".", Base, Suffix) -> + Base ++ Suffix; erlfile(Dir, Base, Suffix) -> filename:join(Dir, Base ++ Suffix). diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index f8128702dd..2514c06360 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -72,7 +72,6 @@ is_pure(erlang, binary_to_list, 1) -> true; is_pure(erlang, binary_to_list, 3) -> true; is_pure(erlang, bit_size, 1) -> true; is_pure(erlang, byte_size, 1) -> true; -is_pure(erlang, concat_binary, 1) -> true; is_pure(erlang, element, 2) -> true; is_pure(erlang, float, 1) -> true; is_pure(erlang, float_to_list, 1) -> true; diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 63527bda8f..39c1e8297f 100644 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -280,3 +280,7 @@ BEAM_FORMAT_NUMBER=0 150: recv_mark/1 151: recv_set/1 152: gc_bif3/7 + +# R15A + +153: line/1 diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 55e3c58d2a..e7dae67085 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -79,9 +79,10 @@ module({Mod,Exp,Attr,Forms}, Options) -> functions(Forms, AtomMod) -> mapfoldl(fun (F, St) -> function(F, AtomMod, St) end, #cg{lcount=1}, Forms). -function({function,Name,Arity,Asm0,Vb,Vdb}, AtomMod, St0) -> +function({function,Name,Arity,Asm0,Vb,Vdb,Anno}, AtomMod, St0) -> try - {Asm,EntryLabel,St} = cg_fun(Vb, Asm0, Vdb, AtomMod, {Name,Arity}, St0), + {Asm,EntryLabel,St} = cg_fun(Vb, Asm0, Vdb, AtomMod, + {Name,Arity}, Anno, St0), Func = {function,Name,Arity,EntryLabel,Asm}, {Func,St} catch @@ -93,7 +94,7 @@ function({function,Name,Arity,Asm0,Vb,Vdb}, AtomMod, St0) -> %% cg_fun([Lkexpr], [HeadVar], Vdb, State) -> {[Ainstr],State} -cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, St0) -> +cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> {Fi,St1} = new_label(St0), %FuncInfo label {Fl,St2} = local_func_label(NameArity, St1), @@ -129,7 +130,7 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, St0) -> ultimate_failure=UltimateMatchFail, is_top_block=true}), {Name,Arity} = NameArity, - Asm = [{label,Fi},{func_info,AtomMod,{atom,Name},Arity}, + Asm = [{label,Fi},line(Anno),{func_info,AtomMod,{atom,Name},Arity}, {label,Fl}|B++[{label,UltimateMatchFail},if_end]], {Asm,Fl,St}. @@ -307,23 +308,23 @@ match_fail_cg({badmatch,Term}, Le, Vdb, Bef, St) -> R = cg_reg_arg(Term, Bef), Int0 = clear_dead(Bef, Le#l.i, Vdb), {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis ++ [{badmatch,R}], + {Sis ++ [line(Le),{badmatch,R}], Int#sr{reg=clear_regs(Int0#sr.reg)},St}; match_fail_cg({case_clause,Reason}, Le, Vdb, Bef, St) -> R = cg_reg_arg(Reason, Bef), Int0 = clear_dead(Bef, Le#l.i, Vdb), {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis++[{case_end,R}], + {Sis++[line(Le),{case_end,R}], Int#sr{reg=clear_regs(Bef#sr.reg)},St}; match_fail_cg(if_clause, Le, Vdb, Bef, St) -> Int0 = clear_dead(Bef, Le#l.i, Vdb), {Sis,Int1} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis++[if_end],Int1#sr{reg=clear_regs(Int1#sr.reg)},St}; + {Sis++[line(Le),if_end],Int1#sr{reg=clear_regs(Int1#sr.reg)},St}; match_fail_cg({try_clause,Reason}, Le, Vdb, Bef, St) -> R = cg_reg_arg(Reason, Bef), Int0 = clear_dead(Bef, Le#l.i, Vdb), {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis ++ [{try_case_end,R}], + {Sis ++ [line(Le),{try_case_end,R}], Int#sr{reg=clear_regs(Int0#sr.reg)},St}. %% bsm_rename_ctx([Clause], Var) -> [Clause] @@ -1047,7 +1048,7 @@ call_cg({var,_V} = Var, As, Rs, Le, Vdb, Bef, St0) -> %% Build complete code and final stack/register state. Arity = length(As), {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ [{call_fun,Arity}],Aft, + {Sis ++ Frees ++ [line(Le),{call_fun,Arity}],Aft, need_stack_frame(St0)}; call_cg({remote,Mod,Name}, As, Rs, Le, Vdb, Bef, St0) when element(1, Mod) =:= var; @@ -1057,11 +1058,10 @@ call_cg({remote,Mod,Name}, As, Rs, Le, Vdb, Bef, St0) Reg = load_vars(Rs, clear_regs(Int#sr.reg)), %% Build complete code and final stack/register state. Arity = length(As), - Call = {apply,Arity}, St = need_stack_frame(St0), %%{Call,St1} = build_call(Func, Arity, St0), {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ [Call],Aft,St}; + {Sis ++ Frees ++ [line(Le),{apply,Arity}],Aft,St}; call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> case St0 of #cg{bfail=Fail} when Fail =/= 0 -> @@ -1091,7 +1091,7 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> Arity = length(As), {Call,St1} = build_call(Func, Arity, St0), {Frees,Aft} = free_dead(clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb)), - {Sis ++ Frees ++ Call,Aft,St1} + {Sis ++ Frees ++ [line(Le)|Call],Aft,St1} end. build_call({remote,{atom,erlang},{atom,'!'}}, 2, St0) -> @@ -1118,7 +1118,7 @@ enter_cg({var,_V} = Var, As, Le, Vdb, Bef, St0) -> {Sis,Int} = cg_setup_call(As++[Var], Bef, Le#l.i, Vdb), %% Build complete code and final stack/register state. Arity = length(As), - {Sis ++ [{call_fun,Arity},return], + {Sis ++ [line(Le),{call_fun,Arity},return], clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), need_stack_frame(St0)}; enter_cg({remote,Mod,Name}, As, Le, Vdb, Bef, St0) @@ -1127,9 +1127,8 @@ enter_cg({remote,Mod,Name}, As, Le, Vdb, Bef, St0) {Sis,Int} = cg_setup_call(As++[Mod,Name], Bef, Le#l.i, Vdb), %% Build complete code and final stack/register state. Arity = length(As), - Call = {apply_only,Arity}, St = need_stack_frame(St0), - {Sis ++ [Call], + {Sis ++ [line(Le),{apply_only,Arity}], clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), St}; enter_cg(Func, As, Le, Vdb, Bef, St0) -> @@ -1137,7 +1136,8 @@ enter_cg(Func, As, Le, Vdb, Bef, St0) -> %% Build complete code and final stack/register state. Arity = length(As), {Call,St1} = build_enter(Func, Arity, St0), - {Sis ++ Call, + Line = enter_line(Func, Arity, Le), + {Sis ++ Line ++ Call, clear_dead(Int#sr{reg=clear_regs(Int#sr.reg)}, Le#l.i, Vdb), St1}. @@ -1153,6 +1153,23 @@ build_enter(Name, Arity, St0) when is_atom(Name) -> {Lbl,St1} = local_func_label(Name, Arity, St0), {[{call_only,Arity,{f,Lbl}}],St1}. +enter_line({remote,{atom,Mod},{atom,Name}}, Arity, Le) -> + case erl_bifs:is_safe(Mod, Name, Arity) of + false -> + %% Tail-recursive call, possibly to a BIF. + %% We'll need a line instruction in case the + %% BIF call fails. + [line(Le)]; + true -> + %% Call to a safe BIF. Since it cannot fail, + %% we don't need any line instruction here. + [] + end; +enter_line(_, _, _) -> + %% Tail-recursive call to a local function. A line + %% instruction will not be useful. + []. + %% local_func_label(Name, Arity, State) -> {Label,State'} %% local_func_label({Name,Arity}, State) -> {Label,State'} %% Get the function entry label for a local function. @@ -1226,9 +1243,10 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> %% Currently, we are somewhat pessimistic in %% that we save any variable that will be live after this BIF call. + MayFail = not erl_bifs:is_safe(erlang, Bif, length(As)), {Sis,Int0} = case St0#cg.in_catch andalso St0#cg.bfail =:= 0 andalso - not erl_bifs:is_safe(erlang, Bif, length(As)) of + MayFail of true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); false -> {[],Bef} end, @@ -1237,7 +1255,14 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> Int = Int1#sr{reg=Reg}, Dst = fetch_reg(V, Reg), BifFail = {f,St0#cg.bfail}, - {Sis++[{bif,Bif,BifFail,Ars,Dst}], + %% We need a line instructions for BIFs that may fail in a body. + Line = case BifFail of + {f,0} when MayFail -> + [line(Le)]; + _ -> + [] + end, + {Sis++Line++[{bif,Bif,BifFail,Ars,Dst}], clear_dead(Int, Le#l.i, Vdb), St0}. @@ -1266,7 +1291,11 @@ gc_bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> Int = Int1#sr{reg=Reg}, Dst = fetch_reg(V, Reg), BifFail = {f,St0#cg.bfail}, - {Sis++[{gc_bif,Bif,BifFail,max_reg(Bef#sr.reg),Ars,Dst}], + Line = case BifFail of + {f,0} -> [line(Le)]; + {f,_} -> [] + end, + {Sis++Line++[{gc_bif,Bif,BifFail,max_reg(Bef#sr.reg),Ars,Dst}], clear_dead(Int, Le#l.i, Vdb), St0}. %% recv_loop_cg(TimeOut, ReceiveVar, ReceiveMatch, TimeOutExprs, @@ -1284,7 +1313,7 @@ recv_loop_cg(Te, Rvar, Rm, Tes, Rs, Le, Vdb, Bef, St0) -> {Wis,Taft,St6} = cg_recv_wait(Te, Tes, Le#l.i, Int1, St5), Int2 = sr_merge(Raft, Taft), %Merge stack/registers Reg = load_vars(Rs, Int2#sr.reg), - {Sis ++ Ris ++ [{label,Tl}] ++ Wis ++ [{label,Bl}], + {Sis ++ [line(Le)] ++ Ris ++ [{label,Tl}] ++ Wis ++ [{label,Bl}], clear_dead(Int2#sr{reg=Reg}, Le#l.i, Vdb), St6#cg{break=St0#cg.break,recv=St0#cg.recv}}. @@ -1463,12 +1492,13 @@ cg_binary([{bs_put_binary,Fail,{atom,all},U,_Flags,Src}|PutCode], {bs_append,Fail,Target,0,MaxRegs,U,Src,BinFlags,Target} end] ++ PutCode, cg_bin_opt(Code); -cg_binary(PutCode, Target, Temp, Fail, MaxRegs, _Anno) -> +cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Anno) -> + Line = line(Anno), Live = cg_live(Target, MaxRegs), {InitOp,SzCode} = cg_binary_size(PutCode, Target, Temp, Fail, Live), - Code = SzCode ++ [{InitOp,Fail,Target,0,MaxRegs, - {field_flags,[]},Target}|PutCode], + Code = [Line|SzCode] ++ [{InitOp,Fail,Target,0,MaxRegs, + {field_flags,[]},Target}|PutCode], cg_bin_opt(Code). cg_live({x,X}, MaxRegs) when X =:= MaxRegs -> MaxRegs+1; @@ -2052,6 +2082,38 @@ drop_catch(Tag, [Other|Stk]) -> [Other|drop_catch(Tag, Stk)]. new_label(#cg{lcount=Next}=St) -> {Next,St#cg{lcount=Next+1}}. +%% line(Le) -> {line,[] | {location,File,Line}} +%% Create a line instruction, containing information about +%% the current filename and line number. A line information +%% instruction should be placed before any operation that could +%% cause an exception. + +line(#l{a=Anno}) -> + line(Anno); +line([Line,{file,Name}]) when is_integer(Line) -> + line_1(Name, Line); +line([_|_]=A) -> + {Name,Line} = find_loc(A, no_file, 0), + line_1(Name, Line); +line([]) -> + {line,[]}. + +line_1(no_file, _) -> + {line,[]}; +line_1(_, 0) -> + %% Missing line number or line number 0. + {line,[]}; +line_1(Name, Line) -> + {line,[{location,Name,abs(Line)}]}. + +find_loc([Line|T], File, _) when is_integer(Line) -> + find_loc(T, File, Line); +find_loc([{file,File}|T], _, Line) -> + find_loc(T, File, Line); +find_loc([_|T], File, Line) -> + find_loc(T, File, Line); +find_loc([], File, Line) -> {File,Line}. + flatmapfoldl(F, Accu0, [Hd|Tail]) -> {R,Accu1} = F(Hd, Accu0), {Rs,Accu2} = flatmapfoldl(F, Accu1, Tail), diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 87bb5bec25..6f3590b156 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -180,7 +180,7 @@ body(Cs0, Name, Arity, St0) -> {Args,St1} = new_vars(Anno, Arity, St0), {Cs1,St2} = clauses(Cs0, St1), {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Fc = function_clause(Ps, {Name,Arity}), + Fc = function_clause(Ps, Anno, {Name,Arity}), {#ifun{anno=#a{anno=Anno},id=[],vars=Args,clauses=Cs1,fc=Fc},St3}. %% clause(Clause, State) -> {Cclause,State} | noclause. @@ -507,15 +507,15 @@ expr({block,_,Es0}, St0) -> {E1,Es1 ++ Eps,St2}; expr({'if',L,Cs0}, St0) -> {Cs1,St1} = clauses(Cs0, St0), - Fc = fail_clause([], #c_literal{val=if_clause}), Lanno = lineno_anno(L, St1), + Fc = fail_clause([], Lanno, #c_literal{val=if_clause}), {#icase{anno=#a{anno=Lanno},args=[],clauses=Cs1,fc=Fc},[],St1}; expr({'case',L,E0,Cs0}, St0) -> {E1,Eps,St1} = novars(E0, St0), {Cs1,St2} = clauses(Cs0, St1), {Fpat,St3} = new_var(St2), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=case_clause},Fpat])), - Lanno = lineno_anno(L, St3), + Lanno = lineno_anno(L, St2), + Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=case_clause},Fpat])), {#icase{anno=#a{anno=Lanno},args=[E1],clauses=Cs1,fc=Fc},Eps,St3}; expr({'receive',L,Cs0}, St0) -> {Cs1,St1} = clauses(Cs0, St0), @@ -541,9 +541,10 @@ expr({'try',L,Es0,Cs0,Ecs,[]}, St0) -> {V,St2} = new_var(St1), %This name should be arbitrary {Cs1,St3} = clauses(Cs0, St2), {Fpat,St4} = new_var(St3), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=try_clause},Fpat])), + Lanno = lineno_anno(L, St4), + Fc = fail_clause([Fpat], Lanno, + c_tuple([#c_literal{val=try_clause},Fpat])), {Evs,Hs,St5} = try_exception(Ecs, St4), - Lanno = lineno_anno(L, St1), {#itry{anno=#a{anno=lineno_anno(L, St5)},args=Es1, vars=[V],body=[#icase{anno=#a{anno=Lanno},args=[V],clauses=Cs1,fc=Fc}], evars=Evs,handler=Hs}, @@ -607,8 +608,8 @@ expr({match,L,P0,E0}, St0) -> Thrown end, {Fpat,St4} = new_var(St3), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=badmatch},Fpat])), Lanno = lineno_anno(L, St4), + Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])), case P2 of nomatch -> St = add_warning(L, nomatch, St4), @@ -828,8 +829,9 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0) -> {Cs1,St1} = clauses(Cs0, St0), {Args,St2} = new_vars(Arity, St1), {Ps,St3} = new_vars(Arity, St2), %Need new variables here - Fc = function_clause(Ps, {Name,Arity}), - Fun = #ifun{anno=#a{anno=lineno_anno(L, St3)}, + Anno = lineno_anno(L, St3), + Fc = function_clause(Ps, Anno, {Name,Arity}), + Fun = #ifun{anno=#a{anno=Anno}, id=[{id,Id}], %We KNOW! vars=Args,clauses=Cs1,fc=Fc}, {Fun,[],St3}. @@ -929,7 +931,7 @@ lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) -> [],St}; lc_tq(Line, E, [Fil0|Qs0], Mc, St0) -> %% Special case sequences guard tests. - LA = lineno_anno(Line, St0), + LA = lineno_anno(element(2, Fil0), St0), LAnno = #a{anno=LA}, case is_guard_test(Fil0) of true -> @@ -945,7 +947,8 @@ lc_tq(Line, E, [Fil0|Qs0], Mc, St0) -> false -> {Lc,Lps,St1} = lc_tq(Line, E, Qs0, Mc, St0), {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=case_clause},Fpat])), + Fc = fail_clause([Fpat], LA, + c_tuple([#c_literal{val=case_clause},Fpat])), %% Do a novars little optimisation here. {Filc,Fps,St3} = novars(Fil0, St2), {#icase{anno=LAnno, @@ -1072,7 +1075,7 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) -> [],St}; bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) -> %% Special case sequences guard tests. - LA = lineno_anno(Line, St0), + LA = lineno_anno(element(2, Fil0), St0), LAnno = #a{anno=LA}, case is_guard_test(Fil0) of true -> @@ -1089,7 +1092,8 @@ bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) -> false -> {Bc,Bps,St1} = bc_tq1(Line, E, Qs0, AccVar, St0), {Fpat,St2} = new_var(St1), - Fc = fail_clause([Fpat], c_tuple([#c_literal{val=case_clause},Fpat])), + Fc = fail_clause([Fpat], LA, + c_tuple([#c_literal{val=case_clause},Fpat])), %% Do a novars little optimisation here. {Filc,Fps,St} = novars(Fil0, St2), {#icase{anno=LAnno, @@ -1562,17 +1566,11 @@ new_vars_1(N, Anno, St0, Vs) when N > 0 -> new_vars_1(N-1, Anno, St1, [V|Vs]); new_vars_1(0, _, St, Vs) -> {Vs,St}. -function_clause(Ps, Name) -> - function_clause(Ps, [], Name). - function_clause(Ps, LineAnno, Name) -> - FcAnno = [{function_name,Name}], + FcAnno = [{function_name,Name}|LineAnno], fail_clause(Ps, FcAnno, ann_c_tuple(LineAnno, [#c_literal{val=function_clause}|Ps])). -fail_clause(Pats, Arg) -> - fail_clause(Pats, [], Arg). - fail_clause(Pats, Anno, Arg) -> #iclause{anno=#a{anno=[compiler_generated]}, pats=Pats,guard=[], diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 3b33a08cf7..4e06b464a4 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -247,7 +247,7 @@ expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) -> %% instead of one for each occurrence as done now. Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} || V <- integers(1, Arity)], - Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{op=Fname,args=Vs}}, + Fun = #c_fun{anno=A,vars=Vs,body=#c_apply{anno=A,op=Fname,args=Vs}}, expr(Fun, Sub, St); expr(#c_var{anno=A,name=V}, Sub, St) -> {#k_var{anno=A,name=get_vsub(V, Sub)},[],St}; @@ -291,7 +291,7 @@ expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> Erl = #c_literal{val=erlang}, Name = #c_literal{val=error}, Args = [#c_literal{val=badarg}], - Error = #c_call{module=Erl,name=Name,args=Args}, + Error = #c_call{anno=A,module=Erl,name=Name,args=Args}, expr(Error, Sub, St0) end; expr(#c_fun{anno=A,vars=Cvs,body=Cb}, Sub0, #kern{ff=OldFF,func=Func}=St0) -> @@ -1167,9 +1167,7 @@ select_bin_int_1(_, _, _, _) -> throw(not_possible). select_assert_match_possible(Sz, Val, Fs) -> EmptyBindings = erl_eval:new_bindings(), - MatchFun = fun({integer,_,_}, NewV, Bs) when NewV =:= Val -> - {match,Bs} - end, + MatchFun = match_fun(Val), EvalFun = fun({integer,_,S}, B) -> {value,S,B} end, Expr = [{bin_element,0,{integer,0,Val},{integer,0,Sz},[{unit,1}|Fs]}], {value,Bin,EmptyBindings} = eval_bits:expr_grp(Expr, EmptyBindings, EvalFun), @@ -1184,6 +1182,11 @@ select_assert_match_possible(Sz, Val, Fs) -> throw(not_possible) end. +match_fun(Val) -> + fun(match, {{integer,_,_},NewV,Bs}) when NewV =:= Val -> + {match,Bs} + end. + select_utf8(Val0) -> try Bin = <<Val0/utf8>>, diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index a7a4d4dc91..a1d92af9f8 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -65,7 +65,7 @@ functions([], Acc) -> reverse(Acc). %% function(Kfunc) -> Func. -function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) -> +function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) -> try As = var_list(Vs), Vdb0 = foldl(fun ({var,N}, Vdb) -> new_var(N, 0, Vdb) end, [], As), @@ -80,7 +80,7 @@ function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) -> put(guard_refc, 0), {B1,_,Vdb1} = body(B0, 1, Vdb0), erase(guard_refc), - {function,F,Ar,As,B1,Vdb1} + {function,F,Ar,As,B1,Vdb1,Anno} catch Class:Error -> Stack = erlang:get_stacktrace(), diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 6a795f6634..f8c71a0257 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -1028,8 +1028,8 @@ haystack_2(Haystack) -> fc({'EXIT',{function_clause,_}}) -> ok; fc({'EXIT',{{case_clause,_},_}}) when ?MODULE =:= bs_match_inline_SUITE -> ok. -fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Args}|_]}}) -> ok; -fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Arity}|_]}}) +fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Args,_}|_]}}) -> ok; +fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Arity,_}|_]}}) when length(Args) =:= Arity -> true = test_server:is_native(?MODULE); fc(_, Args, {'EXIT',{{case_clause,ActualArgs},_}}) diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index b3e5376ffd..8c6a623dfb 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -82,6 +82,7 @@ file_1(Config) when is_list(Config) -> ?line {ok,simple} = compile:file(Simple, [native,report]), %Smoke test. ?line {ok,simple} = compile:file(Target, [native,from_beam]), %Smoke test. ?line {ok,simple} = compile:file(Simple, [debug_info]), + ?line {ok,simple} = compile:file(Simple, [no_line_info]), %Coverage ?line ok = file:set_cwd(Cwd), ?line true = exists(Target), ?line passed = run(Target, test, []), diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 0e69efba6b..40711783ed 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -32,7 +32,8 @@ t_is_boolean/1,is_function_2/1, tricky/1,rel_ops/1,literal_type_tests/1, basic_andalso_orelse/1,traverse_dcd/1, - check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1]). + check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, + bad_constants/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -44,7 +45,8 @@ all() -> more_xor_guards, build_in_guard, old_guard_tests, gbif, t_is_boolean, is_function_2, tricky, rel_ops, literal_type_tests, basic_andalso_orelse, traverse_dcd, - check_qlc_hrl, andalso_semi, t_tuple_size, binary_part]. + check_qlc_hrl, andalso_semi, t_tuple_size, binary_part, + bad_constants]. groups() -> []. @@ -1517,8 +1519,27 @@ bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> -> bptest(_,_,_) -> error. - - +-define(FAILING(C), + if + C -> ?t:fail(should_fail); + true -> ok + end, + if + true, C -> ?t:fail(should_fail); + true -> ok + end). + +bad_constants(Config) when is_list(Config) -> + ?line ?FAILING(false), + ?line ?FAILING([]), + ?line ?FAILING([a]), + ?line ?FAILING([Config]), + ?line ?FAILING({a,b}), + ?line ?FAILING({a,Config}), + ?line ?FAILING(<<1>>), + ?line ?FAILING(42), + ?line ?FAILING(3.14), + ok. %% Call this function to turn off constant propagation. id(I) -> I. diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index af2b8ec92a..086fba2649 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -263,7 +263,8 @@ my_apply(M, F, A, Init) -> really_inlined(Config) when is_list(Config) -> %% Make sure that badarg/2 really gets inlined. - {'EXIT',{badarg,[{?MODULE,fail_me_now,[]}|_]}} = (catch fail_me_now()), + {'EXIT',{badarg,[{?MODULE,fail_me_now,[],_}|_]}} = + (catch fail_me_now()), ok. fail_me_now() -> diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index c8908858ba..f5948504b3 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -179,8 +179,8 @@ empty_generator(Config) when is_list(Config) -> id(I) -> I. -fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args}|_]}}) -> ok; -fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity}|_]}}) +fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok; +fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity,_}|_]}}) when length(Args) =:= Arity -> true = test_server:is_native(?MODULE); fc(Args, {'EXIT',{{case_clause,ActualArgs},_}}) diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index c941a80e61..9b414cade6 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -179,7 +179,7 @@ silly_coverage(Config) when is_list(Config) -> ?line expect_error(fun() -> v3_life:module(BadKernel, []) end), %% v3_codegen - CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b}]}, + CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b,[]}]}, ?line expect_error(fun() -> v3_codegen:module(CodegenInput, []) end), %% beam_block @@ -187,7 +187,7 @@ silly_coverage(Config) when is_list(Config) -> [{function,foo,0,2, [{label,1}, {func_info,{atom,?MODULE},{atom,foo},0}, - {label,2}|non_proper_list],99}]}, + {label,2}|non_proper_list]}],99}, ?line expect_error(fun() -> beam_block:module(BlockInput, []) end), %% beam_bool diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index c6e0f8d85d..760cf17225 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -314,19 +314,19 @@ eclectic(Conf) when is_list(Conf) -> V = {make_ref(),3.1415926535,[[]|{}]}, ?line {{value,{value,V},V},V} = eclectic_1({foo,{value,{value,V}}}, undefined, {value,V}), - ?line {{'EXIT',{V,[{?MODULE,foo,1}|_]}},V} = + ?line {{'EXIT',{V,[{?MODULE,foo,1,_}|_]}},V} = eclectic_1({catch_foo,{error,V}}, undefined, {value,V}), ?line {{error,{exit,V},{'EXIT',V}},V} = eclectic_1({foo,{error,{exit,V}}}, error, {value,V}), ?line {{value,{value,V},V}, - {'EXIT',{badarith,[{?MODULE,my_add,2}|_]}}} = + {'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}} = eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}), ?line {{'EXIT',V},V} = eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}), - ?line {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,2}|_]}}}, + ?line {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,2,_}|_]}}}, {'EXIT',V}} = eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}), - ?line {{{error,V},{'EXIT',{V,[{?MODULE,foo,1}|_]}}}, + ?line {{{error,V},{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}}, {'EXIT',V}} = eclectic_1({catch_foo,{throw,{error,V}}}, undefined, {exit,V}), %% @@ -336,15 +336,15 @@ eclectic(Conf) when is_list(Conf) -> eclectic_2({throw,{value,V}}, throw, {value,V}), ?line {{caught,{'EXIT',V}},undefined} = eclectic_2({value,{value,V}}, undefined, {exit,V}), - ?line {{caught,{'EXIT',{V,[{?MODULE,foo,1}|_]}}},undefined} = + ?line {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} = eclectic_2({error,{value,V}}, throw, {error,V}), - ?line {{caught,{'EXIT',{badarg,[{erlang,abs,[V]}|_]}}},V} = + ?line {{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} = eclectic_2({value,{'abs',V}}, undefined, {value,V}), - ?line {{caught,{'EXIT',{badarith,[{?MODULE,my_add,2}|_]}}},V} = + ?line {{caught,{'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}},V} = eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}), ?line {{caught,{'EXIT',V}},undefined} = eclectic_2({value,{error,V}}, undefined, {exit,V}), - ?line {{caught,{'EXIT',{V,[{?MODULE,foo,1}|_]}}},undefined} = + ?line {{caught,{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}},undefined} = eclectic_2({throw,{'div',{1,0}}}, throw, {error,V}), ok. diff --git a/lib/cosEvent/src/Makefile b/lib/cosEvent/src/Makefile index a62d47ce74..c774d18380 100644 --- a/lib/cosEvent/src/Makefile +++ b/lib/cosEvent/src/Makefile @@ -177,16 +177,18 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_ERL_FILES1) $(EXTERNAL_GEN_HRL_FILES1): CosEventChannelAdmin.idl + +IDL-GENERATED: CosEventChannelAdmin.idl cosEventApp.idl CosEventComm.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosEventChannelAdmin.cfg"}' CosEventChannelAdmin.idl mv $(GEN_HRL_FILES1) $(EXTERNAL_INC_PATH) - -$(GEN_ERL_FILES2) $(GEN_HRL_FILES2): cosEventApp.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"cosEventApp.cfg"}' cosEventApp.idl - -$(GEN_ERL_FILES3) $(EXTERNAL_GEN_HRL_FILES3): CosEventComm.idl erlc $(ERL_IDL_FLAGS) CosEventComm.idl mv $(GEN_HRL_FILES3) $(EXTERNAL_INC_PATH) + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/cosEvent/test/Makefile b/lib/cosEvent/test/Makefile index c59c7ee315..c3f07c156f 100644 --- a/lib/cosEvent/test/Makefile +++ b/lib/cosEvent/test/Makefile @@ -121,17 +121,13 @@ docs: # Special Targets # ---------------------------------------------------- -# -# Each IDL file produces many target files so no pattern -# rule can be used. -# -TGT_COS = \ - $(GEN_HRL_COS:%=$(IDLOUTDIR)/%) \ - $(GEN_MOD_COS:%=$(IDLOUTDIR)/%.erl) +IDL-GENERATED: event_test_server.idl + erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) event_test_server.idl + >IDL-GENERATED +$(GEN_FILES): IDL-GENERATED -$(TGT_COS): event_test_server.idl - erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) event_test_server.idl +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Targets diff --git a/lib/cosEventDomain/src/Makefile b/lib/cosEventDomain/src/Makefile index 56a67cd225..91bef4e7e6 100644 --- a/lib/cosEventDomain/src/Makefile +++ b/lib/cosEventDomain/src/Makefile @@ -150,9 +150,14 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_ERL_FILES) $(EXTERNAL_GEN_HRL_FILES): CosEventDomainAdmin.idl +IDL-GENERATED: CosEventDomainAdmin.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosEventDomainAdmin.cfg"}' CosEventDomainAdmin.idl mv $(GEN_HRL_FILES) $(EXTERNAL_INC_PATH) + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/cosFileTransfer/src/Makefile b/lib/cosFileTransfer/src/Makefile index 773ed7f6b7..17e82f9bc2 100644 --- a/lib/cosFileTransfer/src/Makefile +++ b/lib/cosFileTransfer/src/Makefile @@ -161,9 +161,14 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_ERL_FILES) $(GEN_HRL_FILES): CosFileTransfer.idl +IDL-GENERATED: CosFileTransfer.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosFileTransfer.cfg"}' CosFileTransfer.idl mv $(LOCAL_HRL_FILES) $(EXTERNAL_INC_PATH) + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/cosNotification/src/Makefile b/lib/cosNotification/src/Makefile index 637c633e52..b976ab94f3 100644 --- a/lib/cosNotification/src/Makefile +++ b/lib/cosNotification/src/Makefile @@ -242,20 +242,26 @@ GEN_OE_EVENTCOMM_HRL_FILES = \ oe_CosNotificationComm.hrl \ oe_CosNotificationComm_Event.hrl -GEN_ERL_FILES = \ +IDL_GEN_ERL_FILES = \ $(GEN_NOTIFICATION_ERL_FILES) \ $(GEN_OE_EVENTCOMM_ERL_FILES) \ $(GEN_NOTIFYCOMM_ERL_FILES) \ $(GEN_NOTIFYFILTER_ERL_FILES) \ - $(GEN_CHANNELADMIN_ERL_FILES) \ - $(GEN_YECC_ERL_FILES) + $(GEN_CHANNELADMIN_ERL_FILES) -GEN_HRL_FILES = \ +IDL_GEN_HRL_FILES = \ $(EXTERNAL_GEN_NOTIFICATION_HRL_FILES) \ $(GEN_OE_EVENTCOMM_HRL_FILES) \ $(EXTERNAL_GEN_NOTIFYCOMM_HRL_FILES) \ $(EXTERNAL_GEN_NOTIFYFILTER_HRL_FILES) \ - $(EXTERNAL_GEN_CHANNELADMIN_HRL_FILES) \ + $(EXTERNAL_GEN_CHANNELADMIN_HRL_FILES) + +GEN_ERL_FILES = \ + $(IDL_GEN_ERL_FILES) \ + $(GEN_YECC_ERL_FILES) + +GEN_HRL_FILES = \ + $(IDL_GEN_HRL_FILES) \ $(GEN_YECC_HRL_FILES) @@ -336,20 +342,23 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_NOTIFICATION_ERL_FILES) $(EXTERNAL_GEN_NOTIFICATION_HRL_FILES): CosNotification.idl +IDL-GENERATED: CosNotification.idl CosNotifyChannelAdmin.idl \ + CosNotifyFilter.idl cosNotificationAppComm.idl CosNotifyComm.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosNotification.cfg"}' CosNotification.idl mv $(GEN_NOTIFICATION_HRL_FILES) $(EXTERNAL_INC_PATH) -$(GEN_CHANNELADMIN_ERL_FILES) $(EXTERNAL_GEN_CHANNELADMIN_HRL_FILES): CosNotifyChannelAdmin.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosNotifyChannelAdmin.cfg"}' CosNotifyChannelAdmin.idl mv $(GEN_CHANNELADMIN_HRL_FILES) $(EXTERNAL_INC_PATH) -$(GEN_NOTIFYFILTER_ERL_FILES) $(EXTERNAL_GEN_NOTIFYFILTER_HRL_FILES): CosNotifyFilter.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosNotifyFilter.cfg"}' CosNotifyFilter.idl mv $(GEN_NOTIFYFILTER_HRL_FILES) $(EXTERNAL_INC_PATH) -$(GEN_OE_EVENTCOMM_ERL_FILES) $(GEN_OE_EVENTCOMM_HRL_FILES): cosNotificationAppComm.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"cosNotificationComm.cfg"}' cosNotificationAppComm.idl -$(GEN_NOTIFYCOMM_ERL_FILES) $(EXTERNAL_GEN_NOTIFYCOMM_HRL_FILES): CosNotifyComm.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosNotifyComm.cfg"}' CosNotifyComm.idl mv $(GEN_NOTIFYCOMM_HRL_FILES) $(EXTERNAL_INC_PATH) + >IDL-GENERATED + +$(IDL_GEN_ERL_FILES) $(IDL_GEN_HRL_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED + $(GEN_YECC_ERL_FILES) $(GEN_YECC_HRL_FILES): cosNotification_Grammar.yrl # ---------------------------------------------------- diff --git a/lib/cosNotification/test/Makefile b/lib/cosNotification/test/Makefile index 43f73addae..f509370430 100644 --- a/lib/cosNotification/test/Makefile +++ b/lib/cosNotification/test/Makefile @@ -161,13 +161,14 @@ docs: # Special Targets # ---------------------------------------------------- -TGT_TEST = \ - $(GEN_HRL_FILES:%=$(IDLOUTDIR)/%) \ - $(GEN_MODULES:%=$(IDLOUTDIR)/%.erl) - -$(TGT_TEST): notify_test_server.idl +IDL-GENERATED: notify_test_server.idl erlc $(ERL_COMPILE_FLAGS) -o$(IDLOUTDIR) \ +'{cfgfile,"notify_test_server.cfg"}' notify_test_server.idl + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Targets diff --git a/lib/cosProperty/src/Makefile b/lib/cosProperty/src/Makefile index 1d2119dfb3..d12554b18d 100644 --- a/lib/cosProperty/src/Makefile +++ b/lib/cosProperty/src/Makefile @@ -161,10 +161,14 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_ERL_FILES) $(GEN_HRL_FILES): CosProperty.idl +IDL-GENERATED: CosProperty.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosProperty.cfg"}' CosProperty.idl mv $(LOCAL_HRL_FILES) $(EXTERNAL_INC_PATH) + >IDL-GENERATED +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/cosTime/src/Makefile b/lib/cosTime/src/Makefile index 3b6f7bae2e..1793822fb6 100644 --- a/lib/cosTime/src/Makefile +++ b/lib/cosTime/src/Makefile @@ -176,17 +176,18 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_TIMEBASE_ERL_FILES) $(EXTERNAL_TIMEBASE_HRL_FILES): TimeBase.idl +IDL-GENERATED: TimeBase.idl CosTime.idl CosTimerEvent.idl erlc $(ERL_IDL_FLAGS) TimeBase.idl mv $(GEN_TIMEBASE_HRL_FILES) $(EXTERNAL_INC_PATH) - -$(GEN_COSTIME_ERL_FILES) $(EXTERNAL_COSTIME_HRL_FILES): CosTime.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosTime.cfg"}' CosTime.idl mv $(GEN_COSTIME_HRL_FILES) $(EXTERNAL_INC_PATH) - -$(GEN_COSTIMEREVENT_ERL_FILES) $(EXTERNAL_COSTIMEREVENT_HRL_FILES): CosTimerEvent.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosTimerEvent.cfg"}' CosTimerEvent.idl mv $(GEN_COSTIMEREVENT_HRL_FILES) $(EXTERNAL_INC_PATH) + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/cosTransactions/src/Makefile b/lib/cosTransactions/src/Makefile index 7e10ec175b..4b77251c3c 100644 --- a/lib/cosTransactions/src/Makefile +++ b/lib/cosTransactions/src/Makefile @@ -155,9 +155,14 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_ERL_FILES) $(EXTERNAL_GEN_HRL_FILES): CosTransactions.idl +IDL-GENERATED: CosTransactions.idl erlc $(ERL_IDL_FLAGS) +'{cfgfile,"CosTransactions.cfg"}' CosTransactions.idl mv $(GEN_HRL_FILES) $(EXTERNAL_INC_PATH) + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/cosTransactions/test/Makefile b/lib/cosTransactions/test/Makefile index 44c90e8f84..0bc8c007da 100644 --- a/lib/cosTransactions/test/Makefile +++ b/lib/cosTransactions/test/Makefile @@ -121,13 +121,14 @@ docs: # Special Targets # ---------------------------------------------------- -TGT_TEST = \ - $(GEN_HRL_FILES:%=$(IDLOUTDIR)/%) \ - $(GEN_MODULES:%=$(IDLOUTDIR)/%.erl) - -$(TGT_TEST): etrap_test.idl +IDL-GENERATED: etrap_test.idl erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) \ +'{cfgfile,"etrap_test.cfg"}' etrap_test.idl + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Targets diff --git a/lib/crypto/c_src/Makefile.in b/lib/crypto/c_src/Makefile.in index c2a986c334..285537643e 100644 --- a/lib/crypto/c_src/Makefile.in +++ b/lib/crypto/c_src/Makefile.in @@ -95,13 +95,9 @@ endif # Targets # ---------------------------------------------------- -debug opt valgrind: $(OBJDIR) $(LIBDIR) $(NIF_LIB) +_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) -$(OBJDIR): - -@mkdir -p $(OBJDIR) - -$(LIBDIR): - -@mkdir -p $(LIBDIR) +debug opt valgrind: $(NIF_LIB) $(OBJDIR)/%$(TYPEMARKER).o: %.c $(INSTALL_DIR) $(OBJDIR) diff --git a/lib/debugger/doc/src/debugger_chapter.xml b/lib/debugger/doc/src/debugger_chapter.xml index 1f5d4dd5ff..2d812b0236 100644 --- a/lib/debugger/doc/src/debugger_chapter.xml +++ b/lib/debugger/doc/src/debugger_chapter.xml @@ -254,19 +254,17 @@ c_break(Bindings) -> used, for example, if an error occurs:</p> <pre> 1> <input>catch a+1.</input> -{'EXIT',{badarith,[{erlang,'+',[a,1]}, - {erl_eval,do_apply,5}, - {erl_eval,expr,5}, - {shell,exprs,6}, - {shell,eval_exprs,6}, - {shell,eval_loop,3}]}}</pre> - - <p>In the case above, the stack trace shows that the function called - last was <c>erl_eval:eval_op/3</c>. See <em>Erlang Reference - Manual, Errors and Error handling</em>, for more information - about stack trace.</p> - - <p>Debugger emulates the stack trace by keeping track of recently +{'EXIT',{badarith,[{erlang,'+',[a,1],[]}, + {erl_eval,do_apply,5,[{file,"erl_eval.erl"},{line,562}]}, + {erl_eval,expr,5,[{file,"erl_eval.erl"},{line,359}]}, + {shell,exprs,7,[{file,"shell.erl"},{line,668}]}, + {shell,eval_exprs,7,[{file,"shell.erl"},{line,623}]}, + {shell,eval_loop,3,[{file,"shell.erl"},{line,608}]}]}}</pre> + + <p>See the <em>Erlang Reference Manual, Errors and Error handling</em>, + for more information about the stack trace.</p> + + <p>The Debugger emulates the stack trace by keeping track of recently called interpreted functions. (The real stack trace cannot be used, as it shows which functions of the Debugger have been called, rather than which interpreted functions).</p> @@ -276,17 +274,15 @@ c_break(Bindings) -> <seealso marker="#attach">the Attach Process window</seealso>. </p> - <p>By default, the Debugger saves information about all current + <p>By default, the Debugger only saves information about recursive function calls, that is, function calls that have not yet returned - a value (option 'Stack On, Tail').</p> - - <p>This means, however, that information is saved also for tail - recursive calls. For example, repeated calls to the <c>loop</c> - function of an Erlang process. This may consume unnecessary - amounts of memory for debugged processes with long lifetimes and - many tail recursive calls. It is therefore possible to set - the option 'Stack On, no tail', in which case information about - previous calls are discarded when a tail recursive call is made. + a value (option 'Stack On, No Tail').</p> + + <p>Sometimes, however, it can be useful to save all calls, even + tail-recursive calls. That can be done with the 'Stack On, Tail' + option. Note that this option will consume more memory and slow + down execution of interpreted functions when there are many + tail-recursive calls. </p> <p>It is also possible to turn off the Debugger stack trace diff --git a/lib/debugger/doc/src/int.xml b/lib/debugger/doc/src/int.xml index 8b55461a44..c9d815755d 100644 --- a/lib/debugger/doc/src/int.xml +++ b/lib/debugger/doc/src/int.xml @@ -284,12 +284,12 @@ spawn(Module, Name, [Pid | Args]) <list> <item><c>all</c> - save information about all current calls, that is, function calls that have not yet returned a value. - This is the default.</item> + </item> <item><c>no_tail</c> - save information about current calls, but discard previous information when a tail recursive call is made. This option consumes less memory and may be necessary to use for processes with long lifetimes and many - tail recursive calls.</item> + tail recursive calls. This is the default.</item> <item><c>false</c> - do not save any information about current calls.</item> </list> diff --git a/lib/debugger/src/Makefile b/lib/debugger/src/Makefile index 8551fe887d..6dc7d0d783 100644 --- a/lib/debugger/src/Makefile +++ b/lib/debugger/src/Makefile @@ -44,6 +44,7 @@ MODULES= \ dbg_ieval \ dbg_iload \ dbg_iserver \ + dbg_istk \ dbg_ui_break \ dbg_ui_break_win \ dbg_ui_edit \ diff --git a/lib/debugger/src/dbg_debugged.erl b/lib/debugger/src/dbg_debugged.erl index 3732c40c73..18dcd92ff3 100644 --- a/lib/debugger/src/dbg_debugged.erl +++ b/lib/debugger/src/dbg_debugged.erl @@ -76,8 +76,8 @@ msg_loop(Meta, Mref, SaveStacktrace) -> msg_loop(Meta, Mref, SaveStacktrace); %% Meta needs something evaluated within context of real process - {sys, Meta, {command, Command, Stacktrace}} -> - Reply = handle_command(Command, Stacktrace), + {sys, Meta, {command,Command}} -> + Reply = handle_command(Command), Meta ! {sys, self(), Reply}, msg_loop(Meta, Mref, SaveStacktrace); @@ -93,11 +93,12 @@ msg_loop(Meta, Mref, SaveStacktrace) -> end end. -handle_command(Command, Stacktrace) -> - try reply(Command) +handle_command(Command) -> + try + reply(Command) catch Class:Reason -> - Stacktrace2 = stacktrace_f(erlang:get_stacktrace()), - {exception, {Class,Reason,Stacktrace2++Stacktrace}} + Stacktrace = stacktrace_f(erlang:get_stacktrace()), + {exception,{Class,Reason,Stacktrace}} end. reply({apply,M,F,As}) -> @@ -116,5 +117,5 @@ demonitor(Mref) -> %% Fix stacktrace - keep all above call to this module. %% stacktrace_f([]) -> []; -stacktrace_f([{?MODULE,_,_}|_]) -> []; +stacktrace_f([{?MODULE,_,_,_}|_]) -> []; stacktrace_f([F|S]) -> [F|stacktrace_f(S)]. diff --git a/lib/debugger/src/dbg_icmd.erl b/lib/debugger/src/dbg_icmd.erl index e9502eaa2b..b230efaa7a 100644 --- a/lib/debugger/src/dbg_icmd.erl +++ b/lib/debugger/src/dbg_icmd.erl @@ -273,7 +273,7 @@ handle_int_msg({old_code,Mod}, Status, Bs, erase([Mod|db]), put(cache, []); true -> - case dbg_ieval:in_use_p(Mod, M) of + case dbg_istk:in_use_p(Mod, M) of true -> %% A call to Mod is on the stack (or might be), %% so we must terminate. @@ -342,11 +342,11 @@ handle_user_msg({set,stack_trace,Flag}, _Status, _Bs, _Ieval) -> handle_user_msg({get,bindings,From,SP}, _Status, Bs, _Ieval) -> reply(From, bindings, bindings(Bs, SP)); handle_user_msg({get,stack_frame,From,{Dir,SP}}, _Status, _Bs,_Ieval) -> - reply(From, stack_frame, dbg_ieval:stack_frame(Dir, SP)); + reply(From, stack_frame, dbg_istk:stack_frame(Dir, SP)); handle_user_msg({get,messages,From,_}, _Status, _Bs, _Ieval) -> reply(From, messages, messages()); -handle_user_msg({get,backtrace,From,N}, _Status, _Bs, _Ieval) -> - reply(From, backtrace, dbg_ieval:backtrace(N)). +handle_user_msg({get,backtrace,From,N}, _Status, _Bs, Ieval) -> + reply(From, backtrace, dbg_istk:backtrace(N, Ieval)). set_stack_trace(true) -> set_stack_trace(all); @@ -366,11 +366,11 @@ reply(From, Tag, Reply) -> bindings(Bs, nostack) -> Bs; bindings(Bs, SP) -> - case dbg_ieval:stack_level() of + case dbg_istk:stack_level() of Le when SP > Le -> Bs; _ -> - dbg_ieval:bindings(SP) + dbg_istk:bindings(SP) end. messages() -> @@ -422,7 +422,7 @@ eval_nonrestricted({From, _Mod, Cmd, _SP}, Bs, eval_nonrestricted_1({match,_,{var,_,Var},Expr}, Bs, Ieval) -> {value,Res,Bs2} = - dbg_ieval:eval_expr(Expr, Bs, Ieval#ieval{last_call=false}), + dbg_ieval:eval_expr(Expr, Bs, Ieval#ieval{top=false}), Bs3 = case lists:keyfind(Var, 1, Bs) of {Var,_Value} -> lists:keyreplace(Var, 1, Bs2, {Var,Res}); @@ -437,7 +437,7 @@ eval_nonrestricted_1({var,_,Var}, Bs, _Ieval) -> {Res,Bs}; eval_nonrestricted_1(Expr, Bs, Ieval) -> {value,Res,Bs2} = - dbg_ieval:eval_expr(Expr, Bs, Ieval#ieval{last_call=false}), + dbg_ieval:eval_expr(Expr, Bs, Ieval#ieval{top=false}), {Res,Bs2}. mark_running(LineNo, Le) -> diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 306323f8ea..df725ed9e5 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -20,8 +20,7 @@ -export([eval/3,exit_info/5]). -export([eval_expr/3]). --export([check_exit_msg/3,exception/4,in_use_p/2]). --export([stack_level/0, bindings/1, stack_frame/2, backtrace/1]). +-export([check_exit_msg/3,exception/4]). -include("dbg_ieval.hrl"). @@ -71,13 +70,12 @@ exit_info(Int, AttPid, OrigPid, Reason, ExitInfo) -> case ExitInfo of {{Mod,Line},Bs,S} -> - Stack = binary_to_term(S), - put(stack, Stack), - Le = stack_level(Stack), + dbg_istk:from_external(S), + Le = dbg_istk:stack_level(), dbg_icmd:tell_attached({exit_at, {Mod, Line}, Reason, Le}), exit_loop(OrigPid, Reason, Bs,#ieval{module=Mod,line=Line}); {} -> - put(stack, []), + dbg_istk:init(), dbg_icmd:tell_attached({exit_at, null, Reason, 1}), exit_loop(OrigPid, Reason, erl_eval:new_bindings(),#ieval{}) end. @@ -142,12 +140,12 @@ check_exit_msg({'DOWN',_,_,_,Reason}, Bs, undefined when Le =:= 1 -> % died outside interpreted code {}; undefined when Le > 1 -> - StackBin = term_to_binary(get(stack)), - {{Mod, Li}, Bs, StackBin}; + StackExternal = (dbg_istk:delayed_to_external())(), + {{Mod, Li}, Bs, StackExternal}; %% Debugged has terminated due to an exception - ExitInfo0 -> - ExitInfo0 + ExitInfo0 when is_function(ExitInfo0, 0) -> + ExitInfo0() end, dbg_iserver:cast(get(int), {set_exit_info,self(),ExitInfo}), @@ -170,30 +168,26 @@ check_exit_msg(_Msg, _Bs, _Ieval) -> %% and then raise the exception. %%-------------------------------------------------------------------- exception(Class, Reason, Bs, Ieval) -> - exception(Class, Reason, fix_stacktrace(1), Bs, Ieval). - -exception(Class, Reason, Stacktrace, Bs, #ieval{module=M, line=Line}) -> - ExitInfo = {{M,Line}, Bs, term_to_binary(get(stack))}, + exception(Class, Reason, Bs, Ieval, false). + +exception(Class, Reason, Bs, Ieval, false) -> + do_exception(Class, Reason, + dbg_istk:delayed_stacktrace(no_args, Ieval), + Bs, Ieval); +exception(Class, Reason, Bs, Ieval, true) -> + do_exception(Class, Reason, + dbg_istk:delayed_stacktrace(include_args, Ieval), + Bs, Ieval). + +do_exception(Class, Reason, Stacktrace, Bs, #ieval{module=M, line=Line}) -> + StackFun = dbg_istk:delayed_to_external(), + ExitInfo = fun() -> + {{M,Line},Bs,StackFun()} + end, put(exit_info, ExitInfo), put(stacktrace, Stacktrace), erlang:Class(Reason). -%%-------------------------------------------------------------------- -%% in_use_p(Mod, Cm) -> boolean() -%% Mod = Cm = atom() -%% Returns true if Mod is found on the stack, otherwise false. -%%-------------------------------------------------------------------- -in_use_p(Mod, Mod) -> true; -in_use_p(Mod, _Cm) -> - case get(trace_stack) of - false -> true; - _ -> % all | no_tail - lists:any(fun({_,{M,_,_,_}}) when M =:= Mod -> true; - (_) -> false - end, - get(stack)) - end. - %%==================================================================== %% Internal functions %%==================================================================== @@ -225,7 +219,7 @@ meta(Int, Debugged, M, F, As) -> put(cache, []), put(next_break, Status), % break | running (other values later) put(self, Debugged), % pid() interpreted process - put(stack, []), + dbg_istk:init(), put(stacktrace, []), put(trace_stack, dbg_iserver:call(Int, get_stack_trace)), put(trace, false), % bool() Trace on/off @@ -243,8 +237,7 @@ meta(Int, Debugged, M, F, As) -> debugged_cmd(Cmd, Bs, Ieval) -> Debugged = get(self), - Stacktrace = fix_stacktrace(2), - Debugged ! {sys, self(), {command,Cmd,Stacktrace}}, + Debugged ! {sys, self(), {command,Cmd}}, meta_loop(Debugged, Bs, Ieval). meta_loop(Debugged, Bs, #ieval{level=Le} = Ieval) -> @@ -257,12 +250,17 @@ meta_loop(Debugged, Bs, #ieval{level=Le} = Ieval) -> {value, Val, Bs}; {sys, Debugged, {value,Val,Bs2}} -> {value, Val, Bs2}; - {sys, Debugged, {exception,{Class,Reason,Stacktrace}}} -> + {sys, Debugged, {exception,{Class,Reason,Stk}}} -> case get(exit_info) of - %% Error occured outside interpreted code + %% Error occurred outside of interpreted code. undefined -> - exception(Class,Reason,Stacktrace,Bs,Ieval); + MakeStk0 = dbg_istk:delayed_stacktrace(), + MakeStk = fun(Depth0) -> + Depth = max(0, Depth0 - length(Stk)), + Stk ++ MakeStk0(Depth) + end, + do_exception(Class, Reason, MakeStk, Bs, Ieval); %% Error must have occured within a re-entry to %% interpreted code, simply raise the exception @@ -275,7 +273,7 @@ meta_loop(Debugged, Bs, #ieval{level=Le} = Ieval) -> %% Reset process dictionary %% This is really only necessary if the process left %% interpreted code at a call level > 1 - put(stack, []), + dbg_istk:init(), put(stacktrace, []), put(exit_info, undefined), @@ -313,177 +311,6 @@ exit_loop(OrigPid, Reason, Bs, Ieval) -> exit_loop(OrigPid, Reason, Bs, Ieval) end. -%%--Stack emulation--------------------------------------------------- - -%% We keep track of a call stack that is used for -%% 1) saving stack frames that can be inspected from an Attached -%% Process GUI (using dbg_icmd:get(Meta, stack_frame, {Dir, SP}) -%% 2) generate an approximation of regular stacktrace -- sent to -%% Debugged when it should raise an exception or evaluate a -%% function (since it might possible raise an exception) -%% -%% Stack = [Entry] -%% Entry = {Le, {MFA, Where, Bs}} -%% Le = int() % current call level -%% MFA = {M,F,Args} % called function (or fun) -%% | {Fun,Args} % -%% Where = {M,Li} % from where (module+line) function is called -%% Bs = bindings() % current variable bindings -%% -%% How to push depends on the "Stack Trace" option (value saved in -%% process dictionary item 'trace_stack'). -%% all - everything is pushed -%% no_tail - tail recursive push -%% false - nothing is pushed -%% Whenever a function returns, the corresponding call frame is popped. - -push(MFA, Bs, #ieval{level=Le,module=Cm,line=Li,last_call=Lc}) -> - Entry = {Le, {MFA, {Cm,Li}, Bs}}, - case get(trace_stack) of - false -> ignore; - no_tail when Lc -> - case get(stack) of - [] -> put(stack, [Entry]); - [_Entry|Entries] -> put(stack, [Entry|Entries]) - end; - _ -> % all | no_tail when Lc =:= false - put(stack, [Entry|get(stack)]) - end. - -pop() -> - case get(trace_stack) of - false -> ignore; - _ -> % all � no_tail - case get(stack) of - [_Entry|Entries] -> - put(stack, Entries); - [] -> - ignore - end - end. - -pop(Le) -> - case get(trace_stack) of - false -> ignore; - _ -> % all | no_tail - put(stack, pop(Le, get(stack))) - end. - -pop(Level, [{Le, _}|Stack]) when Level=<Le -> - pop(Level, Stack); -pop(_Level, Stack) -> - Stack. - - -%% stack_level() -> Le -%% stack_level(Stack) -> Le -%% Top call level -stack_level() -> - stack_level(get(stack)). - -stack_level([]) -> 1; -stack_level([{Le,_}|_]) -> Le. - -%% fix_stacktrace(Start) -> Stacktrace -%% Start = 1|2 -%% Stacktrace = [{M,F,Args|Arity} | {Fun,Args}] -%% Convert internal stack format to imitation of regular stacktrace. -%% Max three elements, no repeated (recursive) calls to the same -%% function and convert argument lists to arity for all but topmost -%% entry (and funs). -%% 'Start' indicates where at get(stack) to start. This somewhat ugly -%% solution is because fix_stacktrace has two uses: 1) to imitate -%% the stacktrace in the case of an exception in the interpreted code, -%% in which case the current call (top of the stack = first of the list) -%% should be included, and 2) to send a current stacktrace to Debugged -%% when evaluation passes into non-interpreted code, in which case -%% the current call should NOT be included (as it is Debugged which -%% will make the actual function call). -fix_stacktrace(Start) -> - case fix_stacktrace2(sublist(get(stack), Start, 3)) of - [] -> - []; - [H|T] -> - [H|args2arity(T)] - end. - -sublist([], _Start, _Length) -> - []; % workaround, lists:sublist([],2,3) fails -sublist(L, Start, Length) -> - lists:sublist(L, Start, Length). - -fix_stacktrace2([{_,{{M,F,As1},_,_}}, {_,{{M,F,As2},_,_}}|_]) - when length(As1) =:= length(As2) -> - [{M,F,As1}]; -fix_stacktrace2([{_,{{Fun,As1},_,_}}, {_,{{Fun,As2},_,_}}|_]) - when length(As1) =:= length(As2) -> - [{Fun,As1}]; -fix_stacktrace2([{_,{MFA,_,_}}|Entries]) -> - [MFA|fix_stacktrace2(Entries)]; -fix_stacktrace2([]) -> - []. - -args2arity([{M,F,As}|Entries]) when is_list(As) -> - [{M,F,length(As)}|args2arity(Entries)]; -args2arity([Entry|Entries]) -> - [Entry|args2arity(Entries)]; -args2arity([]) -> - []. - -%% bindings(SP) -> Bs -%% SP = Le % stack pointer -%% Return the bindings for the specified call level -bindings(SP) -> - bindings(SP, get(stack)). - -bindings(SP, [{SP,{_MFA,_Wh,Bs}}|_]) -> - Bs; -bindings(SP, [_Entry|Entries]) -> - bindings(SP, Entries); -bindings(_SP, []) -> - erl_eval:new_bindings(). - -%% stack_frame(Dir, SP) -> {Le, Where, Bs} | top | bottom -%% Dir = up | down -%% Where = {Cm, Li} -%% Cm = Module | undefined % module -%% Li = int() | -1 % line number -%% Bs = bindings() -%% Return stack frame info one step up/down from given stack pointer -%% up = to lower call levels -%% down = to higher call levels -stack_frame(up, SP) -> - stack_frame(SP, up, get(stack)); -stack_frame(down, SP) -> - stack_frame(SP, down, lists:reverse(get(stack))). - -stack_frame(SP, up, [{Le, {_MFA,Where,Bs}}|_]) when Le<SP -> - {Le, Where, Bs}; -stack_frame(SP, down, [{Le, {_MFA,Where,Bs}}|_]) when Le>SP -> - {Le, Where, Bs}; -stack_frame(SP, Dir, [{SP, _}|Stack]) -> - case Stack of - [{Le, {_MFA,Where,Bs}}|_] -> - {Le, Where, Bs}; - [] when Dir =:= up -> - top; - [] when Dir =:= down -> - bottom - end; -stack_frame(SP, Dir, [_Entry|Stack]) -> - stack_frame(SP, Dir, Stack). - -%% backtrace(HowMany) -> Backtrace -%% HowMany = all | int() -%% Backtrace = {Le, MFA} -%% Return all/the last N called functions, in reversed call order -backtrace(HowMany) -> - Stack = case HowMany of - all -> get(stack); - N -> lists:sublist(get(stack), N) - end, - [{Le, MFA} || {Le,{MFA,_Wh,_Bs}} <- Stack]. - %%--Trace function---------------------------------------------------- %%-------------------------------------------------------------------- @@ -558,7 +385,7 @@ format_args1([]) -> %% Mimic catch behaviour catch_value(error, Reason) -> - {'EXIT',{Reason,get(stacktrace)}}; + {'EXIT',{Reason,get_stacktrace()}}; catch_value(exit, Reason) -> {'EXIT',Reason}; catch_value(throw, Reason) -> @@ -570,11 +397,13 @@ catch_value(throw, Reason) -> %% Top level function of meta evaluator. %% Return message to be replied to the target process. %%-------------------------------------------------------------------- -eval_mfa(Debugged, M, F, As, Ieval) -> +eval_mfa(Debugged, M, F, As, #ieval{level=Le}=Ieval0) -> Int = get(int), Bs = erl_eval:new_bindings(), - try eval_function(M,F,As,Bs,extern,Ieval#ieval{last_call=true}) of + Ieval = Ieval0#ieval{level=Le+1,top=true}, + try do_eval_function(M, F, As, Bs, extern, Ieval) of {value, Val, _Bs} -> + trace(return, {Le,Val}), {ready, Val} catch exit:{Debugged, Reason} -> @@ -582,76 +411,68 @@ eval_mfa(Debugged, M, F, As, Ieval) -> exit:{Int, Reason} -> exit(Reason); Class:Reason -> - {exception, {Class, Reason, get(stacktrace)}} + {exception, {Class, Reason, get_stacktrace()}} + end. + +eval_function(Mod, Name, As, Bs, Called, Ieval0, Lc) -> + Tail = Lc andalso get(trace_stack) =:= no_tail, + case Tail of + false -> + Ieval = dbg_istk:push(Bs, Ieval0, Lc), + {value,Val,_} = do_eval_function(Mod, Name, As, Bs, Called, Ieval), + dbg_istk:pop(), + trace(return, {Ieval#ieval.level,Val}), + {value,Val,Bs}; + true -> + do_eval_function(Mod, Name, As, Bs, Called, Ieval0) end. -eval_function(Mod, Fun, As0, Bs0, _Called, Ieval) when is_function(Fun); - Mod =:= ?MODULE, - Fun =:= eval_fun -> - #ieval{level=Le, line=Li, last_call=Lc} = Ieval, +do_eval_function(Mod, Fun, As0, Bs0, _, Ieval0) when is_function(Fun); + Mod =:= ?MODULE, + Fun =:= eval_fun -> + #ieval{level=Le,line=Li,top=Top} = Ieval0, case lambda(Fun, As0) of - {Cs,Module,Name,As,Bs} -> - push({Module,Name,As}, Bs0, Ieval), + {[{clause,Fc,_,_,_}|_]=Cs,Module,Name,As,Bs} -> + Ieval = Ieval0#ieval{module=Module,function=Name, + arguments=As0,line=Fc}, trace(call_fun, {Le,Li,Name,As}), - {value, Val, _Bs} = - fnk_clauses(Cs, Module, Name, As, Bs, - Ieval#ieval{level=Le+1}), - pop(), - trace(return, {Le,Val}), - {value, Val, Bs0}; + fnk_clauses(Cs, As, Bs, Ieval); - not_interpreted when Lc -> % We are leaving interpreted code + not_interpreted when Top -> % We are leaving interpreted code trace(call_fun, {Le,Li,Fun,As0}), {value, {dbg_apply,erlang,apply,[Fun,As0]}, Bs0}; not_interpreted -> - push({Fun,As0}, Bs0, Ieval), trace(call_fun, {Le,Li,Fun,As0}), - {value, Val, _Bs} = - debugged_cmd({apply,erlang,apply,[Fun,As0]},Bs0, - Ieval#ieval{level=Le+1}), - pop(), - trace(return, {Le,Val}), - {value, Val, Bs0}; + debugged_cmd({apply,erlang,apply,[Fun,As0]}, Bs0, Ieval0); {error,Reason} -> %% It's ok not to push anything in this case, the error %% reason contains information about the culprit %% ({badarity,{{Mod,Name},As}}) - exception(error, Reason, Bs0, Ieval) + exception(error, Reason, Bs0, Ieval0) end; %% Common Test adaptation -eval_function(ct_line, line, As, Bs, extern, #ieval{level=Le}=Ieval) -> +do_eval_function(ct_line, line, As, Bs, extern, #ieval{level=Le}=Ieval) -> debugged_cmd({apply,ct_line,line,As}, Bs, Ieval#ieval{level=Le+1}), {value, ignore, Bs}; -eval_function(Mod, Name, As0, Bs0, Called, Ieval) -> - #ieval{level=Le, line=Li, last_call=Lc} = Ieval, - - push({Mod,Name,As0}, Bs0, Ieval), +do_eval_function(Mod, Name, As0, Bs0, Called, Ieval0) -> + #ieval{level=Le,line=Li,top=Top} = Ieval0, trace(call, {Called, {Le,Li,Mod,Name,As0}}), - + Ieval = Ieval0#ieval{module=Mod,function=Name,arguments=As0}, case get_function(Mod, Name, As0, Called) of - Cs when is_list(Cs) -> - {value, Val, _Bs} = - fnk_clauses(Cs, Mod, Name, As0, erl_eval:new_bindings(), - Ieval#ieval{level=Le+1}), - pop(), - trace(return, {Le,Val}), - {value, Val, Bs0}; + [{clause,FcLine,_,_,_}|_]=Cs -> + fnk_clauses(Cs, As0, erl_eval:new_bindings(), + Ieval#ieval{line=FcLine}); - not_interpreted when Lc -> % We are leaving interpreted code + not_interpreted when Top -> % We are leaving interpreted code {value, {dbg_apply,Mod,Name,As0}, Bs0}; not_interpreted -> - {value, Val, _Bs} = - debugged_cmd({apply,Mod,Name,As0}, Bs0, - Ieval#ieval{level=Le+1}), - pop(), - trace(return, {Le,Val}), - {value, Val, Bs0}; + debugged_cmd({apply,Mod,Name,As0}, Bs0, Ieval); undef -> - exception(error, undef, Bs0, Ieval) + exception(error, undef, Bs0, Ieval, true) end. lambda(eval_fun, [Cs,As,Bs,{Mod,Name}=F]) -> @@ -752,23 +573,21 @@ cached(Key) -> %% Try to find a matching function clause %% #ieval.level is set, the other fields must be set in this function -fnk_clauses([{clause,Line,Pars,Gs,Body}|Cs], M, F, As, Bs0, Ieval) -> +fnk_clauses([{clause,Line,Pars,Gs,Body}|Cs], As, Bs0, Ieval) -> case head_match(Pars, As, [], Bs0) of {match,Bs1} -> Bs = add_bindings(Bs1, Bs0), case guard(Gs, Bs) of true -> - seq(Body, Bs, - Ieval#ieval{line=Line, - module=M,function=F,arguments=As}); + seq(Body, Bs, Ieval#ieval{line=Line}); false -> - fnk_clauses(Cs, M, F, As, Bs0, Ieval) + fnk_clauses(Cs, As, Bs0, Ieval) end; nomatch -> - fnk_clauses(Cs, M, F, As, Bs0, Ieval) + fnk_clauses(Cs, As, Bs0, Ieval) end; -fnk_clauses([], _M, _F, _As, Bs, Ieval) -> - exception(error, function_clause, Bs, Ieval). +fnk_clauses([], _As, Bs, Ieval) -> + exception(error, function_clause, Bs, Ieval, true). seq([E], Bs0, Ieval) -> case dbg_icmd:cmd(E, Bs0, Ieval) of @@ -782,7 +601,7 @@ seq([E|Es], Bs0, Ieval) -> {skip,Bs} -> seq(Es, Bs, Ieval); Bs1 -> - {value,_,Bs} = expr(E, Bs1, Ieval#ieval{last_call=false}), + {value,_,Bs} = expr(E, Bs1, Ieval#ieval{top=false}), seq(Es, Bs, Ieval) end; seq([], Bs, _) -> @@ -804,10 +623,9 @@ expr({value,Val}, Bs, _Ieval) -> % Special case straight values %% List expr({cons,Line,H0,T0}, Bs0, Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - Ieval1 = Ieval#ieval{last_call=false}, - {value,H,Bs1} = expr(H0,Bs0,Ieval1), - {value,T,Bs2} = expr(T0,Bs0,Ieval1), + Ieval = Ieval0#ieval{line=Line,top=false}, + {value,H,Bs1} = expr(H0, Bs0, Ieval), + {value,T,Bs2} = expr(T0, Bs0, Ieval), {value,[H|T],merge_bindings(Bs2, Bs1, Ieval)}; %% Tuple @@ -821,12 +639,12 @@ expr({block,Line,Es},Bs,Ieval) -> %% Catch statement expr({'catch',Line,Expr}, Bs0, Ieval) -> - try expr(Expr, Bs0, Ieval#ieval{line=Line, last_call=false}) + try expr(Expr, Bs0, Ieval#ieval{line=Line, top=false}) catch Class:Reason -> %% Exception caught, reset exit info put(exit_info, undefined), - pop(Ieval#ieval.level), + dbg_istk:pop(Ieval#ieval.level), Value = catch_value(Class, Reason), trace(return, {Ieval#ieval.level,Value}), {value, Value, Bs0} @@ -835,7 +653,7 @@ expr({'catch',Line,Expr}, Bs0, Ieval) -> %% Try-catch statement expr({'try',Line,Es,CaseCs,CatchCs,[]}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - try seq(Es, Bs0, Ieval#ieval{last_call=false}) of + try seq(Es, Bs0, Ieval#ieval{top=false}) of {value,Val,Bs} = Value -> case CaseCs of [] -> Value; @@ -848,7 +666,7 @@ expr({'try',Line,Es,CaseCs,CatchCs,[]}, Bs0, Ieval0) -> end; expr({'try',Line,Es,CaseCs,CatchCs,As}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - try seq(Es, Bs0, Ieval#ieval{last_call=false}) of + try seq(Es, Bs0, Ieval#ieval{top=false}) of {value,Val,Bs} = Value -> case CaseCs of [] -> Value; @@ -859,13 +677,13 @@ expr({'try',Line,Es,CaseCs,CatchCs,As}, Bs0, Ieval0) -> Class:Reason when CatchCs =/= [] -> catch_clauses({Class,Reason,[]}, CatchCs, Bs0, Ieval) after - seq(As, Bs0, Ieval#ieval{last_call=false}) + seq(As, Bs0, Ieval#ieval{top=false}) end; %% Case statement expr({'case',Line,E,Cs}, Bs0, Ieval) -> {value,Val,Bs} = - expr(E, Bs0, Ieval#ieval{line=Line, last_call=false}), + expr(E, Bs0, Ieval#ieval{line=Line, top=false}), case_clauses(Val, Cs, Bs, case_clause, Ieval#ieval{line=Line}); %% If statement @@ -874,20 +692,20 @@ expr({'if',Line,Cs}, Bs, Ieval) -> %% Andalso/orelse expr({'andalso',Line,E1,E2}, Bs, Ieval) -> - case expr(E1, Bs, Ieval#ieval{line=Line, last_call=false}) of + case expr(E1, Bs, Ieval#ieval{line=Line, top=false}) of {value,false,_}=Res -> Res; {value,true,_} -> - expr(E2, Bs, Ieval#ieval{line=Line, last_call=false}); + expr(E2, Bs, Ieval#ieval{line=Line, top=false}); {value,Val,Bs} -> exception(error, {badarg,Val}, Bs, Ieval) end; expr({'orelse',Line,E1,E2}, Bs, Ieval) -> - case expr(E1, Bs, Ieval#ieval{line=Line, last_call=false}) of + case expr(E1, Bs, Ieval#ieval{line=Line, top=false}) of {value,true,_}=Res -> Res; {value,false,_} -> - expr(E2, Bs, Ieval#ieval{line=Line, last_call=false}); + expr(E2, Bs, Ieval#ieval{line=Line, top=false}); {value,Val,_} -> exception(error, {badarg,Val}, Bs, Ieval) end; @@ -895,7 +713,7 @@ expr({'orelse',Line,E1,E2}, Bs, Ieval) -> %% Matching expression expr({match,Line,Lhs,Rhs0}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - {value,Rhs,Bs1} = expr(Rhs0, Bs0, Ieval#ieval{last_call=false}), + {value,Rhs,Bs1} = expr(Rhs0, Bs0, Ieval#ieval{top=false}), case match(Lhs, Rhs, Bs1) of {match,Bs} -> {value,Rhs,Bs}; @@ -951,21 +769,21 @@ expr({make_fun,Line,Name,Cs}, Bs, #ieval{module=Module}=Ieval) -> {value,Fun,Bs}; %% Common test adaptation -expr({call_remote,0,ct_line,line,As0}, Bs0, Ieval0) -> +expr({call_remote,0,ct_line,line,As0,Lc}, Bs0, Ieval0) -> {As,_Bs} = eval_list(As0, Bs0, Ieval0), - eval_function(ct_line, line, As, Bs0, extern, Ieval0); + eval_function(ct_line, line, As, Bs0, extern, Ieval0, Lc); %% Local function call -expr({local_call,Line,F,As0}, Bs0, #ieval{module=M} = Ieval0) -> +expr({local_call,Line,F,As0,Lc}, Bs0, #ieval{module=M} = Ieval0) -> Ieval = Ieval0#ieval{line=Line}, {As,Bs} = eval_list(As0, Bs0, Ieval), - eval_function(M, F, As, Bs, local, Ieval); + eval_function(M, F, As, Bs, local, Ieval, Lc); %% Remote function call -expr({call_remote,Line,M,F,As0}, Bs0, Ieval0) -> +expr({call_remote,Line,M,F,As0,Lc}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, {As,Bs} = eval_list(As0, Bs0, Ieval), - eval_function(M, F, As, Bs, extern, Ieval); + eval_function(M, F, As, Bs, extern, Ieval, Lc); %% Emulated semantics of some BIFs expr({dbg,Line,self,[]}, Bs, #ieval{level=Le}) -> @@ -975,9 +793,28 @@ expr({dbg,Line,self,[]}, Bs, #ieval{level=Le}) -> {value,Self,Bs}; expr({dbg,Line,get_stacktrace,[]}, Bs, #ieval{level=Le}) -> trace(bif, {Le,Line,erlang,get_stacktrace,[]}), - Stacktrace = get(stacktrace), + Stacktrace = get_stacktrace(), trace(return, {Le,Stacktrace}), {value,Stacktrace,Bs}; +expr({dbg,Line,raise,As0}, Bs0, #ieval{level=Le}=Ieval0) -> + %% Since erlang:get_stacktrace/0 is emulated, we will + %% need to emulate erlang:raise/3 too so that we can + %% capture the stacktrace. + Ieval = Ieval0#ieval{line=Line}, + {[Class,Reason,Stk0]=As,Bs} = eval_list(As0, Bs0, Ieval), + trace(bif, {Le,Line,erlang,raise,As}), + try + %% Evaluate raise/3 for error checking and + %% truncating of the stacktrace to the correct depth. + Error = erlang:raise(Class, Reason, Stk0), + trace(return, {Le,Error}), + {value,Error,Bs} + catch + _:_ -> + Stk = erlang:get_stacktrace(), %Possibly truncated. + StkFun = fun(_) -> Stk end, + do_exception(Class, Reason, StkFun, Bs, Ieval) + end; expr({dbg,Line,throw,As0}, Bs0, #ieval{level=Le}=Ieval0) -> Ieval = Ieval0#ieval{line=Line}, {[Term],Bs} = eval_list(As0, Bs0, Ieval), @@ -988,11 +825,6 @@ expr({dbg,Line,error,As0}, Bs0, #ieval{level=Le}=Ieval0) -> {[Term],Bs} = eval_list(As0, Bs0, Ieval), trace(bif, {Le,Line,erlang,error,[Term]}), exception(error, Term, Bs, Ieval); -expr({dbg,Line,fault,As0}, Bs0, #ieval{level=Le}=Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {[Term],Bs} = eval_list(As0, Bs0, Ieval), - trace(bif, {Le,Line,erlang,fault,[Term]}), - exception(fault, Term, Bs, Ieval); expr({dbg,Line,exit,As0}, Bs0, #ieval{level=Le}=Ieval0) -> Ieval = Ieval0#ieval{line=Line}, {[Term],Bs} = eval_list(As0, Bs0, Ieval), @@ -1001,36 +833,26 @@ expr({dbg,Line,exit,As0}, Bs0, #ieval{level=Le}=Ieval0) -> %% Call to "safe" BIF, ie a BIF that can be executed in Meta process expr({safe_bif,Line,M,F,As0}, Bs0, #ieval{level=Le}=Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {As,Bs} = eval_list(As0, Bs0, Ieval), + Ieval1 = Ieval0#ieval{line=Line}, + {As,Bs} = eval_list(As0, Bs0, Ieval1), trace(bif, {Le,Line,M,F,As}), - push({M,F,As}, Bs0, Ieval), + Ieval2 = dbg_istk:push(Bs0, Ieval1, false), + Ieval = Ieval2#ieval{module=M,function=F,arguments=As,line=-1}, {_,Value,_} = Res = safe_bif(M, F, As, Bs, Ieval), trace(return, {Le,Value}), - pop(), + dbg_istk:pop(), Res; %% Call to a BIF that must be evaluated in the correct process expr({bif,Line,M,F,As0}, Bs0, #ieval{level=Le}=Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {As,Bs} = eval_list(As0, Bs0, Ieval), + Ieval1 = Ieval0#ieval{line=Line}, + {As,Bs} = eval_list(As0, Bs0, Ieval1), trace(bif, {Le,Line,M,F,As}), - push({M,F,As}, Bs0, Ieval), - {_,Value,_} = - Res = debugged_cmd({apply,M,F,As}, Bs, Ieval#ieval{level=Le+1}), + Ieval2 = dbg_istk:push(Bs0, Ieval1, false), + Ieval = Ieval2#ieval{module=M,function=F,arguments=As,line=-1}, + {_,Value,_} = Res = debugged_cmd({apply,M,F,As}, Bs, Ieval), trace(return, {Le,Value}), - pop(), - Res; - -%% Call to a BIF that spawns a new process -expr({spawn_bif,Line,M,F,As0}, Bs0, #ieval{level=Le}=Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {As,Bs} = eval_list(As0, Bs0, Ieval), - trace(bif, {Le,Line,M,F,As}), - push({M,F,As}, Bs0, Ieval), - Res = debugged_cmd({apply,M,F,As}, Bs,Ieval#ieval{level=Le+1}), - trace(return, {Le,Res}), - pop(), + dbg_istk:pop(), Res; %% Call to an operation @@ -1046,7 +868,7 @@ expr({op,Line,Op,As0}, Bs0, Ieval0) -> end; %% apply/2 (fun) -expr({apply_fun,Line,Fun0,As0}, Bs0, #ieval{level=Le}=Ieval0) -> +expr({apply_fun,Line,Fun0,As0,Lc}, Bs0, #ieval{level=Le}=Ieval0) -> Ieval = Ieval0#ieval{line=Line}, FunValue = case expr(Fun0, Bs0, Ieval) of {value,{dbg_apply,Mx,Fx,Asx},Bsx} -> @@ -1058,31 +880,20 @@ expr({apply_fun,Line,Fun0,As0}, Bs0, #ieval{level=Le}=Ieval0) -> case FunValue of {value,Fun,Bs1} when is_function(Fun) -> {As,Bs} = eval_list(As0, Bs1, Ieval), - eval_function(undefined, Fun, As, Bs, extern, Ieval); + eval_function(undefined, Fun, As, Bs, extern, Ieval, Lc); {value,{M,F},Bs1} when is_atom(M), is_atom(F) -> {As,Bs} = eval_list(As0, Bs1, Ieval), - eval_function(M, F, As, Bs, extern, Ieval); + eval_function(M, F, As, Bs, extern, Ieval, Lc); {value,BadFun,Bs1} -> exception(error, {badfun,BadFun}, Bs1, Ieval) end; %% apply/3 -expr({apply,Line,As0}, Bs0, Ieval0) -> +expr({apply,Line,As0,Lc}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, {[M,F,As],Bs} = eval_list(As0, Bs0, Ieval), - eval_function(M, F, As, Bs, extern, Ieval); + eval_function(M, F, As, Bs, extern, Ieval, Lc); -%% Mod:module_info/0,1 -expr({module_info_0,_,Mod}, Bs, _Ieval) -> - {value,[{compile,module_info(Mod,compile)}, - {attributes,module_info(Mod,attributes)}, - {imports,module_info(Mod,imports)}, - {exports,module_info(Mod,exports)}],Bs}; -expr({module_info_1,Line,Mod,[As0]}, Bs0, Ieval0) -> - Ieval = Ieval0#ieval{line=Line}, - {value,What,Bs} = expr(As0, Bs0, Ieval), - {value,module_info(Mod, What),Bs}; - %% Receive statement expr({'receive',Line,Cs}, Bs0, #ieval{level=Le}=Ieval) -> trace(receivex, {Le,false}), @@ -1091,7 +902,7 @@ expr({'receive',Line,Cs}, Bs0, #ieval{level=Le}=Ieval) -> %% Receive..after statement expr({'receive',Line,Cs,To,ToExprs}, Bs0, #ieval{level=Le}=Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - {value,ToVal,ToBs} = expr(To, Bs0, Ieval#ieval{last_call=false}), + {value,ToVal,ToBs} = expr(To, Bs0, Ieval#ieval{top=false}), trace(receivex, {Le,true}), check_timeoutvalue(ToVal, ToBs, To, Ieval), {Stamp,_} = statistics(wall_clock), @@ -1101,7 +912,7 @@ expr({'receive',Line,Cs,To,ToExprs}, Bs0, #ieval{level=Le}=Ieval0) -> %% Send (!) expr({send,Line,To0,Msg0}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - Ieval1 = Ieval#ieval{last_call=false}, + Ieval1 = Ieval#ieval{top=false}, {value,To,Bs1} = expr(To0, Bs0, Ieval1), {value,Msg,Bs2} = expr(Msg0, Bs0, Ieval1), Bs = merge_bindings(Bs2, Bs1, Ieval), @@ -1110,10 +921,15 @@ expr({send,Line,To0,Msg0}, Bs0, Ieval0) -> %% Binary expr({bin,Line,Fs}, Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - eval_bits:expr_grp(Fs, Bs0, - fun (E, B) -> expr(E, B, Ieval) end, - [], - false); + try + eval_bits:expr_grp(Fs, Bs0, + fun (E, B) -> expr(E, B, Ieval) end, + [], + false) + catch + Class:Reason -> + exception(Class, Reason, Bs0, Ieval) + end; %% List comprehension expr({lc,_Line,E,Qs}, Bs, Ieval) -> @@ -1138,12 +954,12 @@ eval_lc(E, Qs, Bs, Ieval) -> eval_lc1(E, [{generate,Line,P,L0}|Qs], Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{last_call=false}), + {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), CompFun = fun(NewBs) -> eval_lc1(E, Qs, NewBs, Ieval) end, eval_generate(L1, P, Bs1, CompFun, Ieval); eval_lc1(E, [{b_generate,Line,P,L0}|Qs], Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - {value,Bin,_} = expr(L0, Bs0, Ieval#ieval{last_call=false}), + {value,Bin,_} = expr(L0, Bs0, Ieval#ieval{top=false}), CompFun = fun(NewBs) -> eval_lc1(E, Qs, NewBs, Ieval) end, eval_b_generate(Bin, P, Bs0, CompFun, Ieval); eval_lc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> @@ -1152,13 +968,13 @@ eval_lc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> false -> [] end; eval_lc1(E, [Q|Qs], Bs0, Ieval) -> - case expr(Q, Bs0, Ieval#ieval{last_call=false}) of + case expr(Q, Bs0, Ieval#ieval{top=false}) of {value,true,Bs} -> eval_lc1(E, Qs, Bs, Ieval); {value,false,_Bs} -> []; {value,V,Bs} -> exception(error, {bad_filter,V}, Bs, Ieval) end; eval_lc1(E, [], Bs, Ieval) -> - {value,V,_} = expr(E, Bs, Ieval#ieval{last_call=false}), + {value,V,_} = expr(E, Bs, Ieval#ieval{top=false}), [V]. %% eval_bc(Expr,[Qualifier],Bindings,IevalState) -> @@ -1171,12 +987,12 @@ eval_bc(E, Qs, Bs, Ieval) -> eval_bc1(E, [{generate,Line,P,L0}|Qs], Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{last_call=false}), + {value,L1,Bs1} = expr(L0, Bs0, Ieval#ieval{top=false}), CompFun = fun(NewBs) -> eval_bc1(E, Qs, NewBs, Ieval) end, eval_generate(L1, P, Bs1, CompFun, Ieval); eval_bc1(E, [{b_generate,Line,P,L0}|Qs], Bs0, Ieval0) -> Ieval = Ieval0#ieval{line=Line}, - {value,Bin,_} = expr(L0, Bs0, Ieval#ieval{last_call=false}), + {value,Bin,_} = expr(L0, Bs0, Ieval#ieval{top=false}), CompFun = fun(NewBs) -> eval_bc1(E, Qs, NewBs, Ieval) end, eval_b_generate(Bin, P, Bs0, CompFun, Ieval); eval_bc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> @@ -1185,13 +1001,13 @@ eval_bc1(E, [{guard,Q}|Qs], Bs0, Ieval) -> false -> [] end; eval_bc1(E, [Q|Qs], Bs0, Ieval) -> - case expr(Q, Bs0, Ieval#ieval{last_call=false}) of + case expr(Q, Bs0, Ieval#ieval{top=false}) of {value,true,Bs} -> eval_bc1(E, Qs, Bs, Ieval); {value,false,_Bs} -> []; {value,V,Bs} -> exception(error, {bad_filter,V}, Bs, Ieval) end; eval_bc1(E, [], Bs, Ieval) -> - {value,V,_} = expr(E, Bs, Ieval#ieval{last_call=false}), + {value,V,_} = expr(E, Bs, Ieval#ieval{top=false}), [V]. eval_generate([V|Rest], P, Bs0, CompFun, Ieval) -> @@ -1208,7 +1024,7 @@ eval_generate(Term, _P, Bs, _CompFun, Ieval) -> exception(error, {bad_generator,Term}, Bs, Ieval). eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, CompFun, Ieval) -> - Mfun = fun(L, R, Bs) -> match1(L, R, Bs, Bs0) end, + Mfun = match_fun(Bs0), Efun = fun(Exp, Bs) -> expr(Exp, Bs, #ieval{}) end, case eval_bits:bin_gen(P, Bin, erl_eval:new_bindings(), Bs0, Mfun, Efun) of {match,Rest,Bs1} -> @@ -1222,24 +1038,13 @@ eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, CompFun, Ieval) -> eval_b_generate(Term, _P, Bs, _CompFun, Ieval) -> exception(error, {bad_generator,Term}, Bs, Ieval). -module_info(Mod, module) -> Mod; -module_info(_Mod, compile) -> []; -module_info(Mod, attributes) -> - {ok, Attr} = dbg_iserver:call(get(int), {lookup, Mod, attributes}), - Attr; -module_info(_Mod, imports) -> []; -module_info(Mod, exports) -> - {ok, Exp} = dbg_iserver:call(get(int), {lookup, Mod, exports}), - Exp; -module_info(_Mod, functions) -> []. - safe_bif(M, F, As, Bs, Ieval) -> try apply(M, F, As) of Value -> {value,Value,Bs} catch Class:Reason -> - exception(Class, Reason, Bs, Ieval) + exception(Class, Reason, Bs, Ieval, true) end. eval_send(To, Msg, Bs, Ieval) -> @@ -1408,12 +1213,12 @@ flush_traces(Debugged) -> %% eval_list(ExpressionList, Bindings, Ieval) %% Evaluate a list of expressions "in parallel" at the same level. eval_list(Es, Bs, Ieval) -> - eval_list(Es, [], Bs, Bs, Ieval). + eval_list_1(Es, [], Bs, Bs, Ieval#ieval{top=false}). -eval_list([E|Es], Vs, BsOrig, Bs0, Ieval) -> - {value,V,Bs1} = expr(E, BsOrig, Ieval#ieval{last_call=false}), - eval_list(Es, [V|Vs], BsOrig, merge_bindings(Bs1,Bs0,Ieval), Ieval); -eval_list([], Vs, _, Bs, _Ieval) -> +eval_list_1([E|Es], Vs, BsOrig, Bs0, Ieval) -> + {value,V,Bs1} = expr(E, BsOrig, Ieval), + eval_list_1(Es, [V|Vs], BsOrig, merge_bindings(Bs1, Bs0, Ieval), Ieval); +eval_list_1([], Vs, _, Bs, _Ieval) -> {lists:reverse(Vs,[]),Bs}. %% if_clauses(Clauses, Bindings, Ieval) @@ -1453,7 +1258,7 @@ catch_clauses(Exception, [{clause,_,[P],G,B}|CatchCs], Bs0, Ieval) -> true -> %% Exception caught, reset exit info put(exit_info, undefined), - pop(Ieval#ieval.level), + dbg_istk:pop(Ieval#ieval.level), seq(B, Bs, Ieval); false -> catch_clauses(Exception, CatchCs, Bs0, Ieval) @@ -1588,11 +1393,9 @@ match1({cons,_,H,T}, [H1|T1], Bs0, BBs) -> match1({tuple,_,Elts}, Tuple, Bs, BBs) when length(Elts) =:= tuple_size(Tuple) -> match_tuple(Elts, Tuple, 1, Bs, BBs); -match1({bin,_,Fs}, B, Bs0, BBs0) when is_bitstring(B) -> - Bs1 = lists:sort(Bs0), %Kludge. - BBs = lists:sort(BBs0), - try eval_bits:match_bits(Fs, B, Bs1, BBs, - fun(L, R, Bs) -> match1(L, R, Bs, BBs) end, +match1({bin,_,Fs}, B, Bs0, BBs) when is_bitstring(B) -> + try eval_bits:match_bits(Fs, B, Bs0, BBs, + match_fun(BBs), fun(E, Bs) -> expr(E, Bs, #ieval{}) end, false) catch @@ -1601,6 +1404,12 @@ match1({bin,_,Fs}, B, Bs0, BBs0) when is_bitstring(B) -> match1(_,_,_,_) -> throw(nomatch). +match_fun(BBs) -> + fun(match, {L,R,Bs}) -> match1(L, R, Bs, BBs); + (binding, {Name,Bs}) -> binding(Name, Bs); + (add_binding, {Name,Val,Bs}) -> add_binding(Name, Val, Bs) + end. + match_tuple([E|Es], Tuple, I, Bs0, BBs) -> {match,Bs} = match1(E, element(I, Tuple), Bs0, BBs), match_tuple(Es, Tuple, I+1, Bs, BBs); @@ -1731,3 +1540,19 @@ add_binding(N,Val,[B1|Bs]) -> [B1|add_binding(N,Val,Bs)]; add_binding(N,Val,[]) -> [{N,Val}]. + +%% get_stacktrace() -> Stacktrace +%% Return the latest stacktrace for the process. +get_stacktrace() -> + case get(stacktrace) of + MakeStk when is_function(MakeStk, 1) -> + %% The stacktrace has not been constructed before. + %% Construct it and remember the result. + Depth = erlang:system_flag(backtrace_depth, 8), + erlang:system_flag(backtrace_depth, Depth), + Stk = MakeStk(Depth), + put(stacktrace, Stk), + Stk; + Stk when is_list(Stk) -> + Stk + end. diff --git a/lib/debugger/src/dbg_ieval.hrl b/lib/debugger/src/dbg_ieval.hrl index a344748f48..ea6189ad02 100644 --- a/lib/debugger/src/dbg_ieval.hrl +++ b/lib/debugger/src/dbg_ieval.hrl @@ -21,6 +21,8 @@ module, % MFA which called the currently function, % interpreted function arguments, % - last_call = false % True if current expression is - }). % the VERY last to be evaluated - % (ie at all, not only in a clause) + + %% True if the current expression is at the top level + %% (i.e. the next call will leave interpreted code). + top = false + }). diff --git a/lib/debugger/src/dbg_iload.erl b/lib/debugger/src/dbg_iload.erl index 2ae0c333da..ce5631e45f 100644 --- a/lib/debugger/src/dbg_iload.erl +++ b/lib/debugger/src/dbg_iload.erl @@ -62,22 +62,23 @@ load_mod1(Mod, File, Binary, Db) -> store_module(Mod, File, Binary, Db) -> {interpreter_module, Exp, Abst, Src, MD5} = binary_to_term(Binary), Forms = case abstr(Abst) of - {abstract_v1,Forms0} -> Forms0; - {abstract_v2,Forms0} -> Forms0; + {abstract_v1,_} -> + exit({Mod,too_old_beam_file}); + {abstract_v2,_} -> + exit({Mod,too_old_beam_file}); {raw_abstract_v1,Code0} -> Code = interpret_file_attribute(Code0), {_,_,Forms0,_} = sys_pre_expand:module(Code, []), Forms0 end, dbg_idb:insert(Db, mod_file, File), - dbg_idb:insert(Db, exports, Exp), dbg_idb:insert(Db, defs, []), put(vcount, 0), put(fun_count, 0), put(funs, []), put(mod_md5, MD5), - Attr = store_forms(Forms, Mod, Db, Exp, []), + store_forms(Forms, Mod, Db, Exp), erase(mod_md5), erase(current_function), %% store_funs(Db, Mod), @@ -85,11 +86,10 @@ store_module(Mod, File, Binary, Db) -> erase(funs), erase(fun_count), - dbg_idb:insert(Db, attributes, Attr), NewBinary = store_mod_line_no(Mod, Db, binary_to_list(Src)), dbg_idb:insert(Db, mod_bin, NewBinary), - dbg_idb:insert(Db, mod_raw, <<Src/binary,0:8>>), %% Add eos - dbg_idb:insert(Db, module, Mod). + dbg_idb:insert(Db, mod_raw, <<Src/binary,0:8>>). %% Add eos + %% Adjust line numbers using the file/2 attribute. %% Also take the absolute value of line numbers. %% This simple fix will make the marker point at the correct line @@ -111,27 +111,19 @@ abstr(Term) -> Term. % store_funs_1(Fs, Db, Mod); % store_funs_1([], _, _) -> ok. -store_forms([{function,_,module_info,0,_}|Fs], Mod, Db, Exp, Attr) -> - Cs = [{clause,0,[],[], [{module_info_0,0,Mod}]}], - dbg_idb:insert(Db, {Mod,module_info,0,true}, Cs), - store_forms(Fs, Mod, Db, Exp, Attr); -store_forms([{function,_,module_info,1,_}|Fs], Mod, Db, Exp, Attr) -> - Cs = [{clause,0,[{var,0,'What'}],[], [{module_info_1,0,Mod,[{var,0,'What'}]}]}], - dbg_idb:insert(Db, {Mod,module_info,1,true}, Cs), - store_forms(Fs, Mod, Db, Exp, Attr); -store_forms([{function,_,Name,Arity,Cs0}|Fs], Mod, Db, Exp, Attr) -> +store_forms([{function,_,Name,Arity,Cs0}|Fs], Mod, Db, Exp) -> FA = {Name,Arity}, put(current_function, FA), Cs = clauses(Cs0), Exported = lists:member(FA, Exp), dbg_idb:insert(Db, {Mod,Name,Arity,Exported}, Cs), - store_forms(Fs, Mod, Db, Exp, Attr); -store_forms([{attribute,_,Name,Val}|Fs], Mod, Db, Exp, Attr) -> - store_forms(Fs, Mod, Db, Exp, [{Name,Val}|Attr]); -store_forms([F|_], _Mod, _Db, _Exp, _Attr) -> + store_forms(Fs, Mod, Db, Exp); +store_forms([{attribute,_,_Name,_Val}|Fs], Mod, Db, Exp) -> + store_forms(Fs, Mod, Db, Exp); +store_forms([F|_], _Mod, _Db, _Exp) -> exit({unknown_form,F}); -store_forms([], _, _, _, Attr) -> - lists:reverse(Attr). +store_forms([], _, _, _) -> + ok. store_mod_line_no(Mod, Db, Contents) -> store_mod_line_no(Mod, Db, Contents, 1, 0, []). @@ -164,14 +156,14 @@ get_nl([],Pos,Head) -> {lists:reverse(Head),[],Pos}. %%% to interpret. clauses([C0|Cs]) -> - C1 = clause(C0), + C1 = clause(C0, true), [C1|clauses(Cs)]; clauses([]) -> []. -clause({clause,Line,H0,G0,B0}) -> +clause({clause,Line,H0,G0,B0}, Lc) -> H1 = head(H0), G1 = guard(G0), - B1 = exprs(B0), + B1 = exprs(B0, Lc), {clause,Line,H1,G1,B1}. head(Ps) -> patterns(Ps). @@ -219,7 +211,7 @@ pattern({bin,Line,Grp}) -> {bin,Line,Grp1}; pattern({bin_element,Line,Expr,Size,Type}) -> Expr1 = pattern(Expr), - Size1 = expr(Size), + Size1 = expr(Size, false), {bin_element,Line,Expr1,Size1,Type}. %% These patterns are processed "in parallel" for purposes of variable @@ -235,8 +227,6 @@ guard([G0|Gs]) -> [G1|guard(Gs)]; guard([]) -> []. -and_guard([{atom,_,true}|Gs]) -> - and_guard(Gs); and_guard([G0|Gs]) -> G1 = guard_test(G0), [G1|and_guard(Gs)]; @@ -244,12 +234,7 @@ and_guard([]) -> []. guard_test({call,Line,{remote,_,{atom,_,erlang},{atom,_,F}},As0}) -> As = gexpr_list(As0), - case map_guard_bif(F, length(As0)) of - {ok,Name} -> - {safe_bif,Line,erlang,Name,As}; - error -> - {safe_bif,Line,erlang,F,As} - end; + {safe_bif,Line,erlang,F,As}; guard_test({op,Line,Op,L0}) -> true = erl_internal:arith_op(Op, 1) orelse %Assertion. erl_internal:bool_op(Op, 1), @@ -266,25 +251,18 @@ guard_test({op,Line,Op,L0,R0}) -> L1 = gexpr(L0), R1 = gexpr(R0), %They see the same variables {safe_bif,Line,erlang,Op,[L1,R1]}; -guard_test({integer,_,_}=I) -> I; -guard_test({char,_,_}=C) -> C; -guard_test({float,_,_}=F) -> F; -guard_test({atom,_,_}=A) -> A; -guard_test({nil,_}=N) -> N; -guard_test({var,_,_}=V) ->V. % Boolean var - -map_guard_bif(integer, 1) -> {ok,is_integer}; -map_guard_bif(float, 1) -> {ok,is_float}; -map_guard_bif(number, 1) -> {ok,is_number}; -map_guard_bif(atom, 1) -> {ok,is_atom}; -map_guard_bif(list, 1) -> {ok,is_list}; -map_guard_bif(tuple, 1) -> {ok,is_tuple}; -map_guard_bif(pid, 1) -> {ok,is_pid}; -map_guard_bif(reference, 1) -> {ok,is_reference}; -map_guard_bif(port, 1) -> {ok,is_port}; -map_guard_bif(binary, 1) -> {ok,is_binary}; -map_guard_bif(function, 1) -> {ok,is_function}; -map_guard_bif(_, _) -> error. +guard_test({var,_,_}=V) ->V; % Boolean var +guard_test({atom,Line,true}) -> {value,Line,true}; +%% All other constants at this level means false. +guard_test({atom,Line,_}) -> {value,Line,false}; +guard_test({integer,Line,_}) -> {value,Line,false}; +guard_test({char,Line,_}) -> {value,Line,false}; +guard_test({float,Line,_}) -> {value,Line,false}; +guard_test({string,Line,_}) -> {value,Line,false}; +guard_test({nil,Line}) -> {value,Line,false}; +guard_test({cons,Line,_,_}) -> {value,Line,false}; +guard_test({tuple,Line,_}) -> {value,Line,false}; +guard_test({bin,Line,_}) -> {value,Line,false}. gexpr({var,Line,V}) -> {var,Line,V}; gexpr({integer,Line,I}) -> {value,Line,I}; @@ -341,186 +319,179 @@ gexpr_list([]) -> []. %% These expressions are processed "sequentially" for purposes of variable %% definition etc. -exprs([E0|Es]) -> - E1 = expr(E0), - [E1|exprs(Es)]; -exprs([]) -> []. - -expr({var,Line,V}) -> {var,Line,V}; -expr({integer,Line,I}) -> {value,Line,I}; -expr({char,Line,I}) -> {value,Line,I}; -expr({float,Line,F}) -> {value,Line,F}; -expr({atom,Line,A}) -> {value,Line,A}; -expr({string,Line,S}) -> {value,Line,S}; -expr({nil,Line}) -> {value,Line,[]}; -expr({cons,Line,H0,T0}) -> - case {expr(H0),expr(T0)} of +exprs([E], Lc) -> + [expr(E, Lc)]; +exprs([E0|Es], Lc) -> + E1 = expr(E0, false), + [E1|exprs(Es, Lc)]; +exprs([], _Lc) -> []. + +expr({var,Line,V}, _Lc) -> {var,Line,V}; +expr({integer,Line,I}, _Lc) -> {value,Line,I}; +expr({char,Line,I}, _Lc) -> {value,Line,I}; +expr({float,Line,F}, _Lc) -> {value,Line,F}; +expr({atom,Line,A}, _Lc) -> {value,Line,A}; +expr({string,Line,S}, _Lc) -> {value,Line,S}; +expr({nil,Line}, _Lc) -> {value,Line,[]}; +expr({cons,Line,H0,T0}, _Lc) -> + case {expr(H0, false),expr(T0, false)} of {{value,Line,H1},{value,Line,T1}} -> {value,Line,[H1|T1]}; {H1,T1} -> {cons,Line,H1,T1} end; -expr({tuple,Line,Es0}) -> +expr({tuple,Line,Es0}, _Lc) -> Es1 = expr_list(Es0), {tuple,Line,Es1}; -expr({block,Line,Es0}) -> +expr({block,Line,Es0}, Lc) -> %% Unfold block into a sequence. - Es1 = exprs(Es0), + Es1 = exprs(Es0, Lc), {block,Line,Es1}; -expr({'if',Line,Cs0}) -> - Cs1 = icr_clauses(Cs0), +expr({'if',Line,Cs0}, Lc) -> + Cs1 = icr_clauses(Cs0, Lc), {'if',Line,Cs1}; -expr({'case',Line,E0,Cs0}) -> - E1 = expr(E0), - Cs1 = icr_clauses(Cs0), +expr({'case',Line,E0,Cs0}, Lc) -> + E1 = expr(E0, false), + Cs1 = icr_clauses(Cs0, Lc), {'case',Line,E1,Cs1}; -expr({'receive',Line,Cs0}) -> - Cs1 = icr_clauses(Cs0), +expr({'receive',Line,Cs0}, Lc) -> + Cs1 = icr_clauses(Cs0, Lc), {'receive',Line,Cs1}; -expr({'receive',Line,Cs0,To0,ToEs0}) -> - To1 = expr(To0), - ToEs1 = exprs(ToEs0), - Cs1 = icr_clauses(Cs0), +expr({'receive',Line,Cs0,To0,ToEs0}, Lc) -> + To1 = expr(To0, false), + ToEs1 = exprs(ToEs0, Lc), + Cs1 = icr_clauses(Cs0, Lc), {'receive',Line,Cs1,To1,ToEs1}; -expr({'fun',Line,{clauses,Cs0},{_,_,Name}}) when is_atom(Name) -> +expr({'fun',Line,{clauses,Cs0},{_,_,Name}}, _Lc) when is_atom(Name) -> %% New R10B-2 format (abstract_v2). Cs = fun_clauses(Cs0), {make_fun,Line,Name,Cs}; -expr({'fun',Line,{clauses,Cs0},{_,_,_,_,Name}}) when is_atom(Name) -> - %% New R8 format (abstract_v2). - Cs = fun_clauses(Cs0), - {make_fun,Line,Name,Cs}; -expr({'fun',Line,{function,F,A},{_Index,_OldUniq,Name}}) -> +expr({'fun',Line,{function,F,A},{_Index,_OldUniq,Name}}, _Lc) -> %% New R8 format (abstract_v2). As = new_vars(A, Line), - Cs = [{clause,Line,As,[],[{local_call,Line,F,As}]}], + Cs = [{clause,Line,As,[],[{local_call,Line,F,As,true}]}], {make_fun,Line,Name,Cs}; -expr({'fun',_,{clauses,_},{_OldUniq,_Hvss,_Free}}) -> - %% Old format (abstract_v1). - exit({?MODULE,old_funs}); -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,self}},[]}) -> +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,self}},[]}, _Lc) -> {dbg,Line,self,[]}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,get_stacktrace}},[]}) -> +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,get_stacktrace}},[]}, _Lc) -> {dbg,Line,get_stacktrace,[]}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,throw}},[_]=As}) -> +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,throw}},[_]=As}, _Lc) -> {dbg,Line,throw,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,error}},[_]=As}) -> +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,error}},[_]=As}, _Lc) -> {dbg,Line,error,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,fault}},[_]=As}) -> - {dbg,Line,fault,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,exit}},[_]=As}) -> +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,exit}},[_]=As}, _Lc) -> {dbg,Line,exit,expr_list(As)}; -expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,apply}},[_,_,_]=As0}) -> +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,raise}},[_,_,_]=As}, _Lc) -> + {dbg,Line,raise,expr_list(As)}; +expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,apply}},[_,_,_]=As0}, Lc) -> As = expr_list(As0), - {apply,Line,As}; -expr({call,Line,{remote,_,{atom,_,Mod},{atom,_,Func}},As0}) -> + {apply,Line,As,Lc}; +expr({call,Line,{remote,_,{atom,_,Mod},{atom,_,Func}},As0}, Lc) -> As = expr_list(As0), case erlang:is_builtin(Mod, Func, length(As)) of false -> - {call_remote,Line,Mod,Func,As}; + {call_remote,Line,Mod,Func,As,Lc}; true -> - case bif_type(Mod, Func) of + case bif_type(Mod, Func, length(As0)) of safe -> {safe_bif,Line,Mod,Func,As}; - spawn -> {spawn_bif,Line,Mod,Func,As}; unsafe ->{bif,Line,Mod,Func,As} end end; -expr({call,Line,{remote,_,Mod0,Func0},As0}) -> +expr({call,Line,{remote,_,Mod0,Func0},As0}, Lc) -> %% New R8 format (abstract_v2). - Mod = expr(Mod0), - Func = expr(Func0), + Mod = expr(Mod0, false), + Func = expr(Func0, false), As = consify(expr_list(As0)), - {apply,Line,[Mod,Func,As]}; -expr({call,Line,{atom,_,Func},As0}) -> + {apply,Line,[Mod,Func,As],Lc}; +expr({call,Line,{atom,_,Func},As0}, Lc) -> As = expr_list(As0), - {local_call,Line,Func,As}; -expr({call,Line,Fun0,As0}) -> - Fun = expr(Fun0), + {local_call,Line,Func,As,Lc}; +expr({call,Line,Fun0,As0}, Lc) -> + Fun = expr(Fun0, false), As = expr_list(As0), - {apply_fun,Line,Fun,As}; -expr({'catch',Line,E0}) -> + {apply_fun,Line,Fun,As,Lc}; +expr({'catch',Line,E0}, _Lc) -> %% No new variables added. - E1 = expr(E0), + E1 = expr(E0, false), {'catch',Line,E1}; -expr({'try',Line,Es0,CaseCs0,CatchCs0,As0}) -> +expr({'try',Line,Es0,CaseCs0,CatchCs0,As0}, Lc) -> %% No new variables added. Es = expr_list(Es0), - CaseCs = icr_clauses(CaseCs0), - CatchCs = icr_clauses(CatchCs0), + CaseCs = icr_clauses(CaseCs0, Lc), + CatchCs = icr_clauses(CatchCs0, Lc), As = expr_list(As0), {'try',Line,Es,CaseCs,CatchCs,As}; -expr({'query', Line, E0}) -> - E = expr(E0), - {'query', Line, E}; -expr({lc,Line,E0,Gs0}) -> %R8. +expr({lc,Line,E0,Gs0}, _Lc) -> %R8. Gs = lists:map(fun ({generate,L,P0,Qs}) -> - {generate,L,expr(P0),expr(Qs)}; + {generate,L,expr(P0, false),expr(Qs, false)}; ({b_generate,L,P0,Qs}) -> %R12. - {b_generate,L,expr(P0),expr(Qs)}; + {b_generate,L,expr(P0, false),expr(Qs, false)}; (Expr) -> - case is_guard_test(Expr) of - true -> {guard,[[guard_test(Expr)]]}; - false -> expr(Expr) + case is_guard(Expr) of + true -> {guard,guard([[Expr]])}; + false -> expr(Expr, false) end end, Gs0), - {lc,Line,expr(E0),Gs}; -expr({bc,Line,E0,Gs0}) -> %R12. + {lc,Line,expr(E0, false),Gs}; +expr({bc,Line,E0,Gs0}, _Lc) -> %R12. Gs = lists:map(fun ({generate,L,P0,Qs}) -> - {generate,L,expr(P0),expr(Qs)}; + {generate,L,expr(P0, false),expr(Qs, false)}; ({b_generate,L,P0,Qs}) -> %R12. - {b_generate,L,expr(P0),expr(Qs)}; + {b_generate,L,expr(P0, false),expr(Qs, false)}; (Expr) -> - case is_guard_test(Expr) of - true -> {guard,[[guard_test(Expr)]]}; - false -> expr(Expr) + case is_guard(Expr) of + true -> {guard,guard([[Expr]])}; + false -> expr(Expr, false) end end, Gs0), - {bc,Line,expr(E0),Gs}; -expr({match,Line,P0,E0}) -> - E1 = expr(E0), + {bc,Line,expr(E0, false),Gs}; +expr({match,Line,P0,E0}, _Lc) -> + E1 = expr(E0, false), P1 = pattern(P0), {match,Line,P1,E1}; -expr({op,Line,Op,A0}) -> - A1 = expr(A0), +expr({op,Line,Op,A0}, _Lc) -> + A1 = expr(A0, false), {op,Line,Op,[A1]}; -expr({op,Line,'++',L0,R0}) -> - L1 = expr(L0), - R1 = expr(R0), %They see the same variables +expr({op,Line,'++',L0,R0}, _Lc) -> + L1 = expr(L0, false), + R1 = expr(R0, false), %They see the same variables {op,Line,append,[L1,R1]}; -expr({op,Line,'--',L0,R0}) -> - L1 = expr(L0), - R1 = expr(R0), %They see the same variables +expr({op,Line,'--',L0,R0}, _Lc) -> + L1 = expr(L0, false), + R1 = expr(R0, false), %They see the same variables {op,Line,subtract,[L1,R1]}; -expr({op,Line,'!',L0,R0}) -> - L1 = expr(L0), - R1 = expr(R0), %They see the same variables +expr({op,Line,'!',L0,R0}, _Lc) -> + L1 = expr(L0, false), + R1 = expr(R0, false), %They see the same variables {send,Line,L1,R1}; -expr({op,Line,Op,L0,R0}) when Op =:= 'andalso'; Op =:= 'orelse' -> - L1 = expr(L0), - R1 = expr(R0), %They see the same variables +expr({op,Line,Op,L0,R0}, _Lc) when Op =:= 'andalso'; Op =:= 'orelse' -> + L1 = expr(L0, false), + R1 = expr(R0, false), %They see the same variables {Op,Line,L1,R1}; -expr({op,Line,Op,L0,R0}) -> - L1 = expr(L0), - R1 = expr(R0), %They see the same variables +expr({op,Line,Op,L0,R0}, _Lc) -> + L1 = expr(L0, false), + R1 = expr(R0, false), %They see the same variables {op,Line,Op,[L1,R1]}; -expr({bin,Line,Grp}) -> +expr({bin,Line,Grp}, _Lc) -> Grp1 = expr_list(Grp), {bin,Line,Grp1}; -expr({bin_element,Line,Expr,Size,Type}) -> - Expr1 = expr(Expr), - Size1 = expr(Size), +expr({bin_element,Line,Expr,Size,Type}, _Lc) -> + Expr1 = expr(Expr, false), + Size1 = expr(Size, false), {bin_element,Line,Expr1,Size1,Type}; -expr(Other) -> +expr(Other, _Lc) -> exit({?MODULE,{unknown_expr,Other}}). -%% is_guard_test(Expression) -> true | false. -%% Test if a general expression is a guard test. Cannot use erl_lint -%% here as sys_pre_expand has transformed source. +%% is_guard(Expression) -> true | false. +%% Test if a general expression is a guard test or guard BIF. +%% Cannot use erl_lint here as sys_pre_expand has transformed source. -is_guard_test({op,_,Op,L,R}) -> +is_guard({op,_,Op,L,R}) -> erl_internal:comp_op(Op, 2) andalso is_gexpr_list([L,R]); -is_guard_test({call,_,{remote,_,{atom,_,erlang},{atom,_,Test}},As}) -> - erl_internal:type_test(Test, length(As)) andalso is_gexpr_list(As); -is_guard_test({atom,_,true}) -> true; -is_guard_test(_) -> false. +is_guard({call,_,{remote,_,{atom,_,erlang},{atom,_,Test}},As}) -> + Arity = length(As), + (erl_internal:guard_bif(Test, Arity) orelse + erl_internal:old_type_test(Test, Arity)) andalso is_gexpr_list(As); +is_guard({atom,_,true}) -> true; +is_guard(_) -> false. is_gexpr({var,_,_}) -> true; is_gexpr({atom,_,_}) -> true; @@ -555,17 +526,17 @@ consify([]) -> {value,0,[]}. %% definition etc. expr_list([E0|Es]) -> - E1 = expr(E0), + E1 = expr(E0, false), [E1|expr_list(Es)]; expr_list([]) -> []. -icr_clauses([C0|Cs]) -> - C1 = clause(C0), - [C1|icr_clauses(Cs)]; -icr_clauses([]) -> []. +icr_clauses([C0|Cs], Lc) -> + C1 = clause(C0, Lc), + [C1|icr_clauses(Cs, Lc)]; +icr_clauses([], _) -> []. fun_clauses([{clause,L,H,G,B}|Cs]) -> - [{clause,L,head(H),guard(G),exprs(B)}|fun_clauses(Cs)]; + [{clause,L,head(H),guard(G),exprs(B, true)}|fun_clauses(Cs)]; fun_clauses([]) -> []. %% new_var_name() -> VarName. @@ -585,24 +556,21 @@ new_vars(N, L, Vs) when N > 0 -> new_vars(N-1, L, [V|Vs]); new_vars(0, _, Vs) -> Vs. -bif_type(erlang, Name) -> bif_type(Name); -bif_type(_, _) -> unsafe. +bif_type(erlang, Name, Arity) -> + case erl_internal:guard_bif(Name, Arity) of + true -> + %% Guard BIFs are safe (except for self/0, but it is + %% handled with a special instruction anyway). + safe; + false -> + bif_type(Name) + end; +bif_type(_, _, _) -> unsafe. bif_type(register) -> safe; bif_type(unregister) -> safe; bif_type(whereis) -> safe; bif_type(registered) -> safe; -bif_type(abs) -> safe; -bif_type(float) -> safe; -bif_type(trunc) -> safe; -bif_type(round) -> safe; -bif_type(math) -> safe; -bif_type(node) -> safe; -bif_type(length) -> safe; -bif_type(hd) -> safe; -bif_type(tl) -> safe; -bif_type(size) -> safe; -bif_type(element) -> safe; bif_type(setelement) -> safe; bif_type(atom_to_list) -> safe; bif_type(list_to_atom) -> safe; @@ -627,22 +595,14 @@ bif_type(list_to_pid) -> safe; bif_type(module_loaded) -> safe; bif_type(binary_to_term) -> safe; bif_type(term_to_binary) -> safe; -bif_type(alive) -> safe; -bif_type(notalive) -> safe; bif_type(nodes) -> safe; bif_type(is_alive) -> safe; bif_type(disconnect_node) -> safe; bif_type(binary_to_list) -> safe; bif_type(list_to_binary) -> safe; bif_type(split_binary) -> safe; -bif_type(concat_binary) -> safe; -bif_type(term_to_atom) -> safe; bif_type(hash) -> safe; bif_type(pre_loaded) -> safe; -bif_type(info) -> safe; bif_type(set_cookie) -> safe; bif_type(get_cookie) -> safe; -bif_type(spawn) -> spawn; -bif_type(spawn_link) -> spawn; -bif_type(spawn_opt) -> spawn; bif_type(_) -> unsafe. diff --git a/lib/debugger/src/dbg_iserver.erl b/lib/debugger/src/dbg_iserver.erl index 212bc2b8ab..1bb73a43b9 100644 --- a/lib/debugger/src/dbg_iserver.erl +++ b/lib/debugger/src/dbg_iserver.erl @@ -97,13 +97,10 @@ ensure_started() -> %% %% Key Value %% --- ----- -%% attributes Attr -%% exports Exp %% defs [] %% mod_bin Binary %% mod_raw Raw Binary %% mod_file File -%% module Mod %% {Mod,Name,Arity,Exported} Cs %% {'fun',Mod,Index,Uniq} {Name,Arity,Cs} %% Line {Pos,PosNL} @@ -117,7 +114,7 @@ init([]) -> process_flag(trap_exit, true), global:register_name(?MODULE, self()), Db = ets:new(?MODULE, [ordered_set, protected]), - {ok, #state{db=Db, auto=false, stack=all}}. + {ok, #state{db=Db, auto=false, stack=no_tail}}. %% Attaching to a process handle_call({attached, AttPid, Pid}, _From, State) -> diff --git a/lib/debugger/src/dbg_istk.erl b/lib/debugger/src/dbg_istk.erl new file mode 100644 index 0000000000..c6922a80e4 --- /dev/null +++ b/lib/debugger/src/dbg_istk.erl @@ -0,0 +1,245 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(dbg_istk). +-export([init/0,delayed_to_external/0,from_external/1, + push/3,pop/0,pop/1,stack_level/0, + delayed_stacktrace/0,delayed_stacktrace/2, + bindings/1,stack_frame/2,backtrace/2, + in_use_p/2]). + +-include("dbg_ieval.hrl"). + +-define(STACK, ?MODULE). + +-record(e, + {level, %Level + mfa, %{Mod,Func,Args|Arity}|{Fun,Args} + line, %Line called from + bindings, + lc %Last call (true|false) + }). + +init() -> + init([]). + +delayed_to_external() -> + Stack = get(?STACK), + fun() -> {stack,term_to_binary(Stack)} end. + +from_external({stack,Stk}) -> + put(?STACK, binary_to_term(Stk)). + +init(Stack) -> + put(?STACK, Stack). + +%% We keep track of a call stack that is used for +%% 1) saving stack frames that can be inspected from an Attached +%% Process GUI (using dbg_icmd:get(Meta, stack_frame, {Dir, SP}) +%% 2) generate an approximation of regular stacktrace -- sent to +%% Debugged when it should raise an exception or evaluate a +%% function (since it might possible raise an exception) +%% +%% How to push depends on the "Stack Trace" option (value saved in +%% process dictionary item 'trace_stack'). +%% all - everything is pushed +%% no_tail - tail recursive push +%% false - nothing is pushed +%% Whenever a function returns, the corresponding call frame is popped. + +push(Bs, #ieval{level=Le,module=Mod,function=Name, + arguments=As,line=Li}=Ieval, Lc) -> + Entry = #e{level=Le,mfa={Mod,Name,As},line=Li,bindings=Bs,lc=Lc}, + case get(trace_stack) of + false -> + Ieval#ieval{level=Le+1}; + no_tail when Lc -> + Ieval; + _ -> % all | no_tail when Lc =:= false + put(?STACK, [Entry|get(?STACK)]), + Ieval#ieval{level=Le+1} + end. + +pop() -> + case get(trace_stack) of + false -> ignore; + _ -> % all ¦ no_tail + case get(?STACK) of + [_Entry|Entries] -> + put(?STACK, Entries); + [] -> + ignore + end + end. + +pop(Le) -> + case get(trace_stack) of + false -> ignore; + _ -> % all | no_tail + put(?STACK, pop(Le, get(?STACK))) + end. + +pop(Level, [#e{level=Le}|Stack]) when Level =< Le -> + pop(Level, Stack); +pop(_Level, Stack) -> + Stack. + +%% stack_level() -> Le +%% stack_level(Stack) -> Le +%% Top call level +stack_level() -> + stack_level(get(?STACK)). + +stack_level([]) -> 1; +stack_level([#e{level=Le}|_]) -> Le. + +%% delayed_stacktrace() -> CreateStacktraceFun +%% delayed_stacktrace(ArgFlag, #ieval{}) -> CreateStacktraceFun +%% ArgFlag = no_args | include_args +%% CreateStacktraceFun = fun(NumberOfEntries) +%% +%% Return a fun that can convert the internal stack format to +%% an imitation of the regular stacktrace. + +delayed_stacktrace() -> + Stack0 = get(?STACK), + fun(NumEntries) -> + Stack = stacktrace(NumEntries, Stack0, []), + [finalize(ArityOnly) || {ArityOnly,_} <- Stack] + end. + +delayed_stacktrace(include_args, Ieval) -> + #ieval{module=Mod,function=Name,arguments=As,line=Li} = Ieval, + Stack0 = [#e{mfa={Mod,Name,As},line=Li}|get(?STACK)], + fun(NumEntries) -> + case stacktrace(NumEntries, Stack0, []) of + [] -> + []; + [{_,WithArgs}|Stack] -> + [finalize(WithArgs) | + [finalize(ArityOnly) || {ArityOnly,_} <- Stack]] + end + end; +delayed_stacktrace(no_args, Ieval) -> + #ieval{module=Mod,function=Name,arguments=As,line=Li} = Ieval, + Stack0 = [#e{mfa={Mod,Name,As},line=Li}|get(?STACK)], + fun(NumEntries) -> + Stack = stacktrace(NumEntries, Stack0, []), + [finalize(ArityOnly) || {ArityOnly,_} <- Stack] + end. + +stacktrace(N, [#e{lc=true}|T], Acc) -> + stacktrace(N, T, Acc); +stacktrace(N, [E|T], []) -> + stacktrace(N-1, T, [normalize(E)]); +stacktrace(N, [E|T], [{P,_}|_]=Acc) when N > 0 -> + case normalize(E) of + {P,_} -> + stacktrace(N, T, Acc); + New -> + stacktrace(N-1, T, [New|Acc]) + end; +stacktrace(_, _, Acc) -> + lists:reverse(Acc). + +normalize(#e{mfa={M,Fun,As},line=Li}) when is_function(Fun) -> + Loc = {M,Li}, + {{Fun,length(As),Loc},{Fun,As,Loc}}; +normalize(#e{mfa={M,F,As},line=Li}) -> + Loc = {M,Li}, + {{M,F,length(As),Loc},{M,F,As,Loc}}. + +finalize({M,F,A,Loc}) -> {M,F,A,line(Loc)}; +finalize({Fun,A,Loc}) -> {Fun,A,line(Loc)}. + +line({Mod,Line}) when Line > 0 -> + [{file,atom_to_list(Mod)++".erl"},{line,Line}]; +line(_) -> []. + +%% bindings(SP) -> Bs +%% SP = Le % stack pointer +%% Return the bindings for the specified call level +bindings(SP) -> + bindings(SP, get(?STACK)). + +bindings(SP, [#e{level=SP,bindings=Bs}|_]) -> + Bs; +bindings(SP, [_Entry|Entries]) -> + bindings(SP, Entries); +bindings(_SP, []) -> + erl_eval:new_bindings(). + +%% stack_frame(Dir, SP) -> {Le, Where, Bs} | top | bottom +%% Dir = up | down +%% Where = {Cm, Li} +%% Cm = Module | undefined % module +%% Li = int() | -1 % line number +%% Bs = bindings() +%% Return stack frame info one step up/down from given stack pointer +%% up = to lower call levels +%% down = to higher call levels +stack_frame(up, SP) -> + stack_frame(SP, up, get(?STACK)); +stack_frame(down, SP) -> + stack_frame(SP, down, lists:reverse(get(?STACK))). + +stack_frame(SP, up, [#e{level=Le,mfa={Cm,_,_},line=Li,bindings=Bs}|_]) + when Le < SP -> + {Le,{Cm,Li},Bs}; +stack_frame(SP, down, [#e{level=Le,mfa={Cm,_,_},line=Li,bindings=Bs}|_]) + when Le > SP -> + {Le,{Cm,Li},Bs}; +stack_frame(SP, Dir, [#e{level=SP}|Stack]) -> + case Stack of + [#e{level=Le,mfa={Cm,_,_},line=Li,bindings=Bs}|_] -> + {Le,{Cm,Li},Bs}; + [] when Dir =:= up -> + top; + [] when Dir =:= down -> + bottom + end; +stack_frame(SP, Dir, [_Entry|Stack]) -> + stack_frame(SP, Dir, Stack). + +%% backtrace(HowMany) -> Backtrace +%% HowMany = all | int() +%% Backtrace = {Le, MFA} +%% Return all/the last N called functions, in reversed call order +backtrace(HowMany, Ieval) -> + #ieval{level=Level,module=Mod,function=Name,arguments=As} = Ieval, + Stack0 = [#e{level=Level,mfa={Mod,Name,As}}|get(?STACK)], + Stack = case HowMany of + all -> Stack0; + N -> lists:sublist(Stack0, N) + end, + [{Le,MFA} || #e{level=Le,mfa=MFA} <- Stack]. + +%%-------------------------------------------------------------------- +%% in_use_p(Mod, Cm) -> boolean() +%% Mod = Cm = atom() +%% Returns true if Mod is found on the stack, otherwise false. +%%-------------------------------------------------------------------- +in_use_p(Mod, Mod) -> true; +in_use_p(Mod, _Cm) -> + case get(trace_stack) of + false -> true; + _ -> % all | no_tail + lists:any(fun(#e{mfa={M,_,_}}) when M =:= Mod -> true; + (_) -> false + end, get(?STACK)) + end. diff --git a/lib/debugger/src/debugger.app.src b/lib/debugger/src/debugger.app.src index 21cf59a2e1..5538f66260 100644 --- a/lib/debugger/src/debugger.app.src +++ b/lib/debugger/src/debugger.app.src @@ -26,6 +26,7 @@ dbg_ieval, dbg_iload, dbg_iserver, + dbg_istk, dbg_ui_break, dbg_ui_break_win, dbg_ui_edit, diff --git a/lib/debugger/test/Makefile b/lib/debugger/test/Makefile index 2296bd0ae6..3dfbed31ff 100644 --- a/lib/debugger/test/Makefile +++ b/lib/debugger/test/Makefile @@ -43,6 +43,7 @@ MODULES= \ exception_SUITE \ fun_SUITE \ lc_SUITE \ + line_number_SUITE \ record_SUITE \ trycatch_SUITE \ test_lib \ diff --git a/lib/debugger/test/bs_construct_SUITE.erl b/lib/debugger/test/bs_construct_SUITE.erl index 5c7d49e951..187c9f53b0 100644 --- a/lib/debugger/test/bs_construct_SUITE.erl +++ b/lib/debugger/test/bs_construct_SUITE.erl @@ -19,18 +19,31 @@ -module(bs_construct_SUITE). +%% Copied from bs_construct_SUITE in the emulator test suite. +%% The following test cases have been omitted since they don't +%% make much sense for the debugger: +%% bs_add +%% kostis + -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, - test1/1, test2/1, test3/1, test4/1, test5/1, testf/1, not_used/1, in_guard/1, - coerce_to_float/1]). + test1/1, test2/1, test3/1, test4/1, test5/1, testf/1, + not_used/1, in_guard/1, + mem_leak/1, coerce_to_float/1, bjorn/1, + huge_float_field/1, huge_binary/1, system_limit/1, badarg/1, + copy_writable_binary/1, dynamic/1, + otp_7422/1, zero_width/1]). -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - cases(). + [test1, test2, test3, test4, test5, testf, not_used, + in_guard, mem_leak, coerce_to_float, bjorn, + huge_float_field, huge_binary, system_limit, badarg, + copy_writable_binary, dynamic, otp_7422, zero_width]. groups() -> []. @@ -41,11 +54,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - -cases() -> - [test1, test2, test3, test4, test5, testf, not_used, - in_guard, coerce_to_float]. - init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), Dog = test_server:timetrap(?t:minutes(1)), @@ -75,7 +83,9 @@ r(L) -> -define(T(B, L), {B, ??B, L}). -define(N(B), {B, ??B, unknown}). --define(FAIL(Expr), ?line {'EXIT',{badarg,_}} = (catch Expr)). +-define(FAIL(Expr), ?line fail_check(catch Expr, ??Expr, [])). + +-define(FAIL_VARS(Expr, Vars), ?line fail_check(catch Expr, ??Expr, Vars)). l(I_13, I_big1) -> [ @@ -143,7 +153,13 @@ l(I_13, I_big1) -> native_3798()), ?T(<<32978297842987249827298387697777669766334937:128/native-integer>>, - native_bignum()) + native_bignum()), + + %% Unit tests. + ?T(<<<<5:3>>/bitstring>>, <<5:3>>), + ?T(<<42,<<7:4>>/binary-unit:4>>, <<42,7:4>>), + ?T(<<<<344:17>>/binary-unit:17>>, <<344:17>>), + ?T(<<<<42,3,7656:16>>/binary-unit:16>>, <<42,3,7656:16>>) ]. @@ -179,7 +195,7 @@ eval_list([{C_bin, Str, Bytes} | Rest], Vars) -> [{C_bin, E_bin, Str, Bytes} | eval_list(Rest, Vars)] end. -one_test({C_bin, E_bin, Str, Bytes}) when list(Bytes) -> +one_test({C_bin, E_bin, Str, Bytes}) when is_list(Bytes) -> io:format(" ~s, ~p~n", [Str, Bytes]), Bin = list_to_binary(Bytes), if @@ -222,7 +238,7 @@ one_test({C_bin, E_bin, Str, Result}) -> ok; %% For situations where the final bits may not matter, like %% for floats: - N when integer(N) -> + N when is_integer(N) -> io:format("Info: compiled and interpreted differ in the" " last bytes:~n ~p, ~p.~n", [binary_to_list(C_bin), binary_to_list(E_bin)]), @@ -248,9 +264,22 @@ equal_lists(A, B, R) -> false end. +fail_check({'EXIT',{badarg,_}}, Str, Vars) -> + try evaluate(Str, Vars) of + Res -> + io:format("Interpreted result: ~p", [Res]), + ?t:fail(did_not_fail_in_intepreted_code) + catch + error:badarg -> + ok + end; +fail_check(Res, _, _) -> + io:format("Compiled result: ~p", [Res]), + ?t:fail(did_not_fail_in_compiled_code). + %%% Simple working cases test1(suite) -> []; -test1(Config) when list(Config) -> +test1(Config) when is_list(Config) -> ?line I_13 = i(13), ?line I_big1 = big(1), ?line Vars = [{'I_13', I_13}, @@ -272,7 +301,7 @@ gen_l(N, S, A) -> [?T(<<A:S/little, A:(N-S)/little>>, comp(N, A, S))]. test2(suite) -> []; -test2(Config) when list(Config) -> +test2(Config) when is_list(Config) -> ?line test2(0, 8, 2#10101010101010101), ?line test2(0, 8, 2#1111111111). @@ -300,7 +329,7 @@ t3() -> ]. test3(suite) -> []; -test3(Config) when list(Config) -> +test3(Config) when is_list(Config) -> ?line Vars = [], ?line lists:foreach(fun one_test/1, eval_list(t3(), Vars)). @@ -311,7 +340,7 @@ gen_u_l(N, S, A) -> [?N(<<A:S/little, A:(N-S)/little>>)]. test4(suite) -> []; -test4(Config) when list(Config) -> +test4(Config) when is_list(Config) -> ?line test4(0, 16, 2#10101010101010101), ?line test4(0, 16, 2#1111111111). @@ -333,7 +362,7 @@ gen_b(N, S, A) -> test5(suite) -> []; test5(doc) -> ["OTP-3995"]; -test5(Config) when list(Config) -> +test5(Config) when is_list(Config) -> ?line test5(0, 8, <<73>>), ?line test5(0, 8, <<68>>). @@ -350,40 +379,63 @@ test5(S, A) -> %%% Failure cases testf(suite) -> []; -testf(Config) when list(Config) -> - ?FAIL(<<3.14>>), - ?FAIL(<<<<1,2>>>>), - - ?FAIL(<<2.71/binary>>), - ?FAIL(<<24334/binary>>), - ?FAIL(<<24334344294788947129487129487219847/binary>>), - - ?FAIL(<<<<1,2,3>>/float>>), +testf(Config) when is_list(Config) -> + ?line ?FAIL(<<3.14>>), + ?line ?FAIL(<<<<1,2>>>>), + + ?line ?FAIL(<<2.71/binary>>), + ?line ?FAIL(<<24334/binary>>), + ?line ?FAIL(<<24334344294788947129487129487219847/binary>>), + BigInt = id(24334344294788947129487129487219847), + ?line ?FAIL_VARS(<<BigInt/binary>>, [{'BigInt',BigInt}]), + ?line ?FAIL_VARS(<<42,BigInt/binary>>, [{'BigInt',BigInt}]), + ?line ?FAIL_VARS(<<BigInt:2/binary>>, [{'BigInt',BigInt}]), + + %% One negative field size, but the sum of field sizes will be 1 byte. + %% Make sure that we reject that properly. + I_minus_777 = id(-777), + I_minus_2047 = id(-2047), + ?line ?FAIL_VARS(<<I_minus_777:2048/unit:8,57:I_minus_2047/unit:8>>, + ordsets:from_list([{'I_minus_777',I_minus_777}, + {'I_minus_2047',I_minus_2047}])), + ?line ?FAIL(<<<<1,2,3>>/float>>), %% Negative field widths. - testf_1(-8, <<1,2,3,4,5>>), - - ?FAIL(<<42:(-16)>>), - ?FAIL(<<3.14:(-8)/float>>), - ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>), - ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>), - ?FAIL(<<<<23,56,0,2>>:(anka)>>), + ?line testf_1(-8, <<1,2,3,4,5>>), + ?line ?FAIL(<<0:(-(1 bsl 100))>>), + + ?line ?FAIL(<<42:(-16)>>), + ?line ?FAIL(<<3.14:(-8)/float>>), + ?line ?FAIL(<<<<23,56,0,2>>:(-16)/binary>>), + ?line ?FAIL(<<<<23,56,0,2>>:(2.5)/binary>>), + ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>), + ?line ?FAIL(<<<<23,56,0,2>>:(anka)>>), + + %% Unit failures. + ?line ?FAIL(<<<<1:1>>/binary>>), + Sz = id(1), + ?line ?FAIL_VARS(<<<<1:Sz>>/binary>>, [{'Sz',Sz}]), + ?line {'EXIT',{badarg,_}} = (catch <<<<1:(id(1))>>/binary>>), + ?line ?FAIL(<<<<7,8,9>>/binary-unit:16>>), + ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:16>>), + ?line ?FAIL(<<<<7,8,9,3:7>>/binary-unit:17>>), ok. testf_1(W, B) -> - ?FAIL(<<42:W>>), - ?FAIL(<<3.14:W/float>>), - ?FAIL(<<B:W/binary>>). + Vars = [{'W',W}], + ?FAIL_VARS(<<42:W>>, Vars), + ?FAIL_VARS(<<3.14:W/float>>, Vars), + ?FAIL_VARS(<<B:W/binary>>, [{'B',B}|Vars]). not_used(doc) -> "Test that constructed binaries that are not used will still give an exception."; not_used(Config) when is_list(Config) -> ?line ok = not_used1(3, <<"dum">>), - ?line ?FAIL(not_used1(3, "dum")), - ?line ?FAIL(not_used2(444, -2)), - ?line ?FAIL(not_used2(444, anka)), - ?line ?FAIL(not_used3(444)), + ?line {'EXIT',{badarg,_}} = (catch not_used1(3, "dum")), + ?line {'EXIT',{badarg,_}} = (catch not_used2(444, -2)), + ?line {'EXIT',{badarg,_}} = (catch not_used2(444, anka)), + ?line {'EXIT',{badarg,_}} = (catch not_used3(444)), ok. not_used1(I, BinString) -> @@ -398,7 +450,7 @@ not_used3(I) -> <<I:(-8)>>, ok. -in_guard(Config) when list(Config) -> +in_guard(Config) when is_list(Config) -> ?line 1 = in_guard(<<16#74ad:16>>, 16#e95, 5), ?line 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), ?line 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), @@ -415,6 +467,36 @@ in_guard(Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3; in_guard(Bin, A, B) when {a,b,<<A:14,B/float,3:2>>} == Bin -> cant_happen; in_guard(_, _, _) -> nope. +mem_leak(doc) -> "Make sure that construction has no memory leak"; +mem_leak(Config) when is_list(Config) -> + ?line B = make_bin(16, <<0>>), + ?line mem_leak(1024, B), + ok. + +mem_leak(0, _) -> ok; +mem_leak(N, B) -> + ?line big_bin(B, <<23>>), + ?line {'EXIT',{badarg,_}} = (catch big_bin(B, bad)), + maybe_gc(), + mem_leak(N-1, B). + +big_bin(B1, B2) -> + <<B1/binary,B1/binary,B1/binary,B1/binary, + B1/binary,B1/binary,B1/binary,B1/binary, + B1/binary,B1/binary,B1/binary,B1/binary, + B1/binary,B1/binary,B1/binary,B1/binary, + B2/binary>>. + +make_bin(0, Acc) -> Acc; +make_bin(N, Acc) -> make_bin(N-1, <<Acc/binary,Acc/binary>>). + +maybe_gc() -> + case erlang:system_info(heap_type) of + shared -> erlang:garbage_collect(); + hybrid -> erlang:garbage_collect(); + private -> ok + end. + -define(COF(Int0), ?line (fun(Int) -> true = <<Int:32/float>> =:= <<(float(Int)):32/float>>, @@ -431,7 +513,7 @@ in_guard(_, _, _) -> nope. nonliteral(X) -> X. -coerce_to_float(Config) when list(Config) -> +coerce_to_float(Config) when is_list(Config) -> ?COF(0), ?COF(-1), ?COF(1), @@ -444,3 +526,232 @@ coerce_to_float(Config) when list(Config) -> ?COF64(298748888888888888888888888883478264866528467367364766666666666666663), ?COF64(-367546729879999999999947826486652846736736476555566666663), ok. + +bjorn(Config) when is_list(Config) -> + ?line error = bjorn_1(), + ok. + +bjorn_1() -> + Bitstr = <<7:13>>, + try + do_something() + catch + throw:blurf -> + ignore + end, + do_more(Bitstr, 13). + +do_more(Bin, Sz) -> + %% Previous bug in the bs_bits_to_bytes instruction: The exeption code + %% was not set - the previous exception (throw:blurf) would be used, + %% causing the catch to slip. + try <<Bin:Sz/binary>> of + _V -> ok + catch + error:_ -> + error + end. + +do_something() -> + throw(blurf). + +huge_float_field(Config) when is_list(Config) -> + ?line {'EXIT',{badarg,_}} = (catch <<0.0:9/float-unit:8>>), + ?line huge_float_check(catch <<0.0:67108865/float-unit:64>>), + ?line huge_float_check(catch <<0.0:((1 bsl 26)+1)/float-unit:64>>), + ?line huge_float_check(catch <<0.0:(id(67108865))/float-unit:64>>), +%% ?line huge_float_check(catch <<0.0:((1 bsl 60)+1)/float-unit:64>>), + ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 26)+1)/float-unit:64>>), +%% ?line huge_float_check(catch <<3839739387439387383739387987347983:((1 bsl 60)+1)/float-unit:64>>), + ok. + +huge_float_check({'EXIT',{system_limit,_}}) -> ok; +huge_float_check({'EXIT',{badarg,_}}) -> ok. + +huge_binary(Config) when is_list(Config) -> + ?line 16777216 = size(<<0:(id(1 bsl 26)),(-1):(id(1 bsl 26))>>), + ok. + +system_limit(Config) when is_list(Config) -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + ?line {'EXIT',{system_limit,_}} = + (catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>), + ?line {'EXIT',{system_limit,_}} = + (catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>), + ?line {'EXIT',{system_limit,_}} = + (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>), + + case WordSize of + 4 -> + system_limit_32(); + 8 -> + ok + end. + +system_limit_32() -> + ?line {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), + ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), + ?line {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + ?line {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), + ?line {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), + ?line {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), + ?line {'EXIT',{system_limit,_}} = + (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), + ok. + +badarg(Config) when is_list(Config) -> + %% BEAM will generate a badarg exception for: + %% <<0:(id(1 bsl 100)),0:(id(-1))>> + %% but the debugger will generate a system_limit exception. + %% It does not seems worthwhile to fix the debugger. + + ?line {'EXIT',{badarg,_}} = + (catch <<(id(<<>>))/binary,0:(id(-(1 bsl 100)))>>), + + ok. + +copy_writable_binary(Config) when is_list(Config) -> + ?line [copy_writable_binary_1(I) || I <- lists:seq(0, 256)], + ok. + +copy_writable_binary_1(_) -> + ?line Bin0 = <<(id(<<>>))/binary,0,1,2,3,4,5,6,7>>, + ?line SubBin = make_sub_bin(Bin0), + ?line id(<<42,34,55,Bin0/binary>>), %Make reallocation likelier. + ?line Pid = spawn(fun() -> + copy_writable_binary_holder(Bin0, SubBin) + end), + ?line Tab = ets:new(holder, []), + ?line ets:insert(Tab, {17,Bin0}), + ?line ets:insert(Tab, {42,SubBin}), + ?line id(<<Bin0/binary,0:(64*1024*8)>>), + ?line Pid ! self(), + ?line [{17,Bin0}] = ets:lookup(Tab, 17), + ?line [{42,Bin0}] = ets:lookup(Tab, 42), + receive + {Pid,Bin0,Bin0} -> ok; + Other -> + io:format("Unexpected message: ~p", [Other]), + ?line ?t:fail() + end, + ok. + +copy_writable_binary_holder(Bin, SubBin) -> + receive + Pid -> + Pid ! {self(),Bin,SubBin} + end. + +make_sub_bin(Bin0) -> + N = bit_size(Bin0), + <<_:17,Bin:N/bitstring,_:5>> = <<(-1):17,Bin0/bitstring,(-1):5>>, + Bin = Bin0, %Assertion. + Bin. + +%% Test that different ways of using bit syntax instructions +%% give the same result. + +dynamic(Config) when is_list(Config) -> + ?line dynamic_1(fun dynamic_big/5), + ?line dynamic_1(fun dynamic_little/5), + ok. + +dynamic_1(Dynamic) -> + <<Lpad:128>> = erlang:md5([0]), + <<Rpad:128>> = erlang:md5([1]), + <<Int:128>> = erlang:md5([2]), + 8385 = dynamic_2(0, {Int,Lpad,Rpad,Dynamic}, 0). + +dynamic_2(129, _, Count) -> Count; +dynamic_2(Bef, Data, Count0) -> + Count = dynamic_3(Bef, 128-Bef, Data, Count0), + dynamic_2(Bef+1, Data, Count). + +dynamic_3(_, -1, _, Count) -> Count; +dynamic_3(Bef, N, {Int0,Lpad,Rpad,Dynamic}=Data, Count) -> + Int1 = Int0 band ((1 bsl (N+3))-1), + Dynamic(Bef, N, Int1, Lpad, Rpad), + Dynamic(Bef, N, -Int1, Lpad, Rpad), + + %% OTP-7085: Test a small number in a wide field. + Int2 = Int0 band 16#FFFFFF, + Dynamic(Bef, N, Int2, Lpad, Rpad), + Dynamic(Bef, N, -Int2, Lpad, Rpad), + dynamic_3(Bef, N-1, Data, Count+1). + +dynamic_big(Bef, N, Int, Lpad, Rpad) -> + NumBin = id(<<Int:N>>), + MaskedInt = Int band ((1 bsl N) - 1), + <<MaskedInt:N>> = NumBin, + + %% Construct the binary in two different ways. + Bin = id(<<Lpad:Bef,NumBin/bitstring,Rpad:(128-Bef-N)>>), + Bin = <<Lpad:Bef,Int:N,Rpad:(128-Bef-N)>>, + + %% Further verify the result by matching. + LpadMasked = Lpad band ((1 bsl Bef) - 1), + RpadMasked = Rpad band ((1 bsl (128-Bef-N)) - 1), + Rbits = (128-Bef-N), + <<LpadMasked:Bef,MaskedInt:N,RpadMasked:Rbits>> = id(Bin), + ok. + +dynamic_little(Bef, N, Int, Lpad, Rpad) -> + NumBin = id(<<Int:N/little>>), + MaskedInt = Int band ((1 bsl N) - 1), + <<MaskedInt:N/little>> = NumBin, + + %% Construct the binary in two different ways. + Bin = id(<<Lpad:Bef/little,NumBin/bitstring,Rpad:(128-Bef-N)/little>>), + Bin = <<Lpad:Bef/little,Int:N/little,Rpad:(128-Bef-N)/little>>, + + %% Further verify the result by matching. + LpadMasked = Lpad band ((1 bsl Bef) - 1), + RpadMasked = Rpad band ((1 bsl (128-Bef-N)) - 1), + Rbits = (128-Bef-N), + <<LpadMasked:Bef/little,MaskedInt:N/little,RpadMasked:Rbits/little>> = id(Bin), + ok. + +otp_7422(Config) when is_list(Config) -> + otp_7422_int(0), + otp_7422_bin(0). + +otp_7422_int(N) when N < 512 -> + T = erlang:make_tuple(N, []), + spawn_link(fun() -> + id(T), + %% A size of field 0 would write one byte beyond + %% the current position in the binary. It could + %% overwrite the continuation pointer stored on + %% the stack if HTOP was equal to E (the stack pointer). + id(<<0:(id(0))>>) + end), + otp_7422_int(N+1); +otp_7422_int(_) -> ok. + +otp_7422_bin(N) when N < 512 -> + T = erlang:make_tuple(N, []), + Z = id(<<>>), + spawn_link(fun() -> + id(T), + id(<<Z:(id(0))/bits>>) + end), + otp_7422_bin(N+1); +otp_7422_bin(_) -> ok. + +zero_width(Config) when is_list(Config) -> + ?line Z = id(0), + Small = id(42), + Big = id(1 bsl 128), + ?line <<>> = <<Small:Z>>, + ?line <<>> = <<Small:0>>, + ?line <<>> = <<Big:Z>>, + ?line <<>> = <<Big:0>>, + + ?line {'EXIT',{badarg,_}} = (catch <<not_a_number:0>>), + ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):Z>>), + ?line {'EXIT',{badarg,_}} = (catch <<(id(not_a_number)):0>>), + + ok. + +id(I) -> I. diff --git a/lib/debugger/test/bs_match_bin_SUITE.erl b/lib/debugger/test/bs_match_bin_SUITE.erl index b42b84aef2..5a7c30f16b 100644 --- a/lib/debugger/test/bs_match_bin_SUITE.erl +++ b/lib/debugger/test/bs_match_bin_SUITE.erl @@ -24,14 +24,14 @@ -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, - byte_split_binary/1,bit_split_binary/1]). + byte_split_binary/1,bit_split_binary/1,match_huge_bin/1]). -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - cases(). + [byte_split_binary, bit_split_binary, match_huge_bin]. groups() -> []. @@ -42,10 +42,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - -cases() -> - [byte_split_binary, bit_split_binary]. - init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), Dog = test_server:timetrap(?t:minutes(1)), @@ -65,11 +61,12 @@ end_per_suite(Config) when is_list(Config) -> ok. byte_split_binary(doc) -> "Tries to split a binary at all byte-aligned positions."; -byte_split_binary(suite) -> []; -byte_split_binary(Config) when list(Config) -> +byte_split_binary(Config) when is_list(Config) -> ?line L = lists:seq(0, 57), ?line B = mkbin(L), - ?line byte_split(L, B, size(B)). + ?line byte_split(L, B, size(B)), + ?line Unaligned = make_unaligned_sub_binary(B), + ?line byte_split(L, Unaligned, size(Unaligned)). byte_split(L, B, Pos) when Pos >= 0 -> ?line Sz1 = Pos, @@ -78,18 +75,19 @@ byte_split(L, B, Pos) when Pos >= 0 -> ?line B1 = list_to_binary(lists:sublist(L, 1, Pos)), ?line B2 = list_to_binary(lists:nthtail(Pos, L)), ?line byte_split(L, B, Pos-1); -byte_split(_L, _B, _) -> ok. +byte_split(_, _, _) -> ok. bit_split_binary(doc) -> "Tries to split a binary at all positions."; -bit_split_binary(suite) -> []; -bit_split_binary(Config) when list(Config) -> +bit_split_binary(Config) when is_list(Config) -> Fun = fun(Bin, List, SkipBef, N) -> ?line SkipAft = 8*size(Bin) - N - SkipBef, - io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]), - ?line <<_I1:SkipBef,OutBin:N/binary-unit:1,_I2:SkipAft>> = Bin, + %%io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]), + ?line <<_:SkipBef,OutBin:N/binary-unit:1,_:SkipAft>> = Bin, ?line OutBin = make_bin_from_list(List, N) end, ?line bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)), + ?line bit_split_binary1(Fun, + make_unaligned_sub_binary(erlang:md5(<<1,2,3>>))), ok. bit_split_binary1(Action, Bin) -> @@ -99,24 +97,23 @@ bit_split_binary1(Action, Bin) -> bit_split_binary2(Action, Bin, [_|T]=List, Bef) -> bit_split_binary3(Action, Bin, List, Bef, size(Bin)*8), bit_split_binary2(Action, Bin, T, Bef+1); -bit_split_binary2(_Action, _Bin, [], _Bef) -> ok. +bit_split_binary2(_, _, [], _) -> ok. bit_split_binary3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> Action(Bin, List, Bef, (Aft-Bef) div 8 * 8), bit_split_binary3(Action, Bin, List, Bef, Aft-8); bit_split_binary3(_, _, _, _, _) -> ok. -make_bin_from_list(_List, 0) -> - mkbin([]); +make_bin_from_list(_, 0) -> mkbin([]); make_bin_from_list(List, N) -> list_to_binary([make_int(List, 8, 0), make_bin_from_list(lists:nthtail(8, List), N-8)]). -make_int(_List, 0, Acc) -> Acc; +make_int(_, 0, Acc) -> Acc; make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). -bits_to_list([_H|T], 0) -> bits_to_list(T, 16#80); +bits_to_list([_|T], 0) -> bits_to_list(T, 16#80); bits_to_list([H|_]=List, Mask) -> [case H band Mask of 0 -> 0; @@ -124,5 +121,109 @@ bits_to_list([H|_]=List, Mask) -> end|bits_to_list(List, Mask bsr 1)]; bits_to_list([], _) -> []. +mkbin(L) when is_list(L) -> list_to_binary(L). + +make_unaligned_sub_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +id(I) -> I. + +match_huge_bin(Config) when is_list(Config) -> + ?line Bin = <<0:(1 bsl 27),13:8>>, + ?line skip_huge_bin_1(1 bsl 27, Bin), + ?line 16777216 = match_huge_bin_1(1 bsl 27, Bin), + + %% Test overflowing the size of a binary field. + ?line nomatch = overflow_huge_bin_skip_32(Bin), + ?line nomatch = overflow_huge_bin_32(Bin), + ?line nomatch = overflow_huge_bin_skip_64(Bin), + ?line nomatch = overflow_huge_bin_64(Bin), + + %% Size in variable + ?line ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ?line ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + + ok. + +overflow_huge_bin(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/binary-unit:8,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<NewBin:Sz/binary-unit:8,0,_/binary>> -> + {error,Sz,size(NewBin)}; + _ -> + overflow_huge_bin(Bin, Sizes) + end + end; +overflow_huge_bin(_, []) -> ok. + +overflow_huge_bin_unit128(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/binary-unit:128,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<NewBin:Sz/binary-unit:128,0,_/binary>> -> + {error,Sz,size(NewBin)}; + _ -> + overflow_huge_bin_unit128(Bin, Sizes) + end + end; +overflow_huge_bin_unit128(_, []) -> ok. + +skip_huge_bin_1(I, Bin) -> + <<_:I/binary-unit:1,13>> = Bin, + ok. -mkbin(L) when list(L) -> list_to_binary(L). +match_huge_bin_1(I, Bin) -> + case Bin of + <<Val:I/binary-unit:1,13>> -> size(Val); + _ -> nomatch + end. + +overflow_huge_bin_skip_32(<<_:4294967296/binary,0,_/binary>>) -> 1; % 1 bsl 32 +overflow_huge_bin_skip_32(<<_:33554432/binary-unit:128,0,_/binary>>) -> 2; % 1 bsl 25 +overflow_huge_bin_skip_32(<<_:67108864/binary-unit:64,0,_/binary>>) -> 3; % 1 bsl 26 +overflow_huge_bin_skip_32(<<_:134217728/binary-unit:32,0,_/binary>>) -> 4; % 1 bsl 27 +overflow_huge_bin_skip_32(<<_:268435456/binary-unit:16,0,_/binary>>) -> 5; % 1 bsl 28 +overflow_huge_bin_skip_32(<<_:536870912/binary-unit:8,0,_/binary>>) -> 6; % 1 bsl 29 +overflow_huge_bin_skip_32(<<_:1073741824/binary-unit:8,0,_/binary>>) -> 7; % 1 bsl 30 +overflow_huge_bin_skip_32(<<_:2147483648/binary-unit:8,0,_/binary>>) -> 8; % 1 bsl 31 +overflow_huge_bin_skip_32(_) -> nomatch. + +overflow_huge_bin_32(<<Bin:4294967296/binary,_/binary>>) -> {1,Bin}; % 1 bsl 32 +overflow_huge_bin_32(<<Bin:33554432/binary-unit:128,0,_/binary>>) -> {2,Bin}; % 1 bsl 25 +overflow_huge_bin_32(<<Bin:67108864/binary-unit:128,0,_/binary>>) -> {3,Bin}; % 1 bsl 26 +overflow_huge_bin_32(<<Bin:134217728/binary-unit:128,0,_/binary>>) -> {4,Bin}; % 1 bsl 27 +overflow_huge_bin_32(<<Bin:268435456/binary-unit:128,0,_/binary>>) -> {5,Bin}; % 1 bsl 28 +overflow_huge_bin_32(<<Bin:536870912/binary-unit:128,0,_/binary>>) -> {6,Bin}; % 1 bsl 29 +overflow_huge_bin_32(<<Bin:1073741824/binary-unit:128,0,_/binary>>) -> {7,Bin}; % 1 bsl 30 +overflow_huge_bin_32(<<Bin:2147483648/binary-unit:128,0,_/binary>>) -> {8,Bin}; % 1 bsl 31 +overflow_huge_bin_32(_) -> nomatch. + +overflow_huge_bin_skip_64(<<_:18446744073709551616/binary,0,_/binary>>) -> 1; % 1 bsl 64 +overflow_huge_bin_skip_64(<<_:144115188075855872/binary-unit:128,0,_/binary>>) -> 2; % 1 bsl 57 +overflow_huge_bin_skip_64(<<_:288230376151711744/binary-unit:64,0,_/binary>>) -> 3; % 1 bsl 58 +overflow_huge_bin_skip_64(<<_:576460752303423488/binary-unit:32,0,_/binary>>) -> 4; % 1 bsl 59 +overflow_huge_bin_skip_64(<<_:1152921504606846976/binary-unit:16,0,_/binary>>) -> 5; % 1 bsl 60 +overflow_huge_bin_skip_64(<<_:2305843009213693952/binary-unit:8,0,_/binary>>) -> 6; % 1 bsl 61 +overflow_huge_bin_skip_64(<<_:4611686018427387904/binary-unit:8,0,_/binary>>) -> 7; % 1 bsl 62 +overflow_huge_bin_skip_64(<<_:9223372036854775808/binary-unit:8,_/binary>>) -> 8; % 1 bsl 63 +overflow_huge_bin_skip_64(_) -> nomatch. + +overflow_huge_bin_64(<<Bin:18446744073709551616/binary,_/binary>>) -> {1,Bin}; % 1 bsl 64 +overflow_huge_bin_64(<<Bin:144115188075855872/binary-unit:128,0,_/binary>>) -> {2,Bin}; % 1 bsl 57 +overflow_huge_bin_64(<<Bin:288230376151711744/binary-unit:128,0,_/binary>>) -> {3,Bin}; % 1 bsl 58 +overflow_huge_bin_64(<<Bin:576460752303423488/binary-unit:128,0,_/binary>>) -> {4,Bin}; % 1 bsl 59 +overflow_huge_bin_64(<<Bin:1152921504606846976/binary-unit:128,0,_/binary>>) -> {5,Bin}; % 1 bsl 60 +overflow_huge_bin_64(<<Bin:2305843009213693952/binary-unit:128,0,_/binary>>) -> {6,Bin}; % 1 bsl 61 +overflow_huge_bin_64(<<Bin:4611686018427387904/binary-unit:128,0,_/binary>>) -> {7,Bin}; % 1 bsl 62 +overflow_huge_bin_64(<<Bin:9223372036854775808/binary-unit:128,0,_/binary>>) -> {8,Bin}; % 1 bsl 63 +overflow_huge_bin_64(_) -> nomatch. diff --git a/lib/debugger/test/bs_match_int_SUITE.erl b/lib/debugger/test/bs_match_int_SUITE.erl index 745368fdfc..bff5f8ff65 100644 --- a/lib/debugger/test/bs_match_int_SUITE.erl +++ b/lib/debugger/test/bs_match_int_SUITE.erl @@ -19,11 +19,11 @@ -module(bs_match_int_SUITE). --author('[email protected]'). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, - integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1]). + integer/1,signed_integer/1,dynamic/1,more_dynamic/1,mml/1, + match_huge_int/1,bignum/1,unaligned_32_bit/1]). -include_lib("test_server/include/test_server.hrl"). @@ -32,7 +32,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [cases()]. + [integer, signed_integer, dynamic, more_dynamic, mml, + match_huge_int, bignum, unaligned_32_bit]. groups() -> []. @@ -43,10 +44,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - -cases() -> - [integer, signed_integer, dynamic, more_dynamic, mml]. - init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), Dog = test_server:timetrap(?t:minutes(4)), @@ -65,8 +62,7 @@ init_per_suite(Config) when is_list(Config) -> end_per_suite(Config) when is_list(Config) -> ok. -integer(suite) -> []; -integer(Config) when list(Config) -> +integer(Config) when is_list(Config) -> ?line 0 = get_int(mkbin([])), ?line 0 = get_int(mkbin([0])), ?line 42 = get_int(mkbin([42])), @@ -78,22 +74,33 @@ integer(Config) when list(Config) -> ?line 65534 = get_int(mkbin([255,254])), ?line 16776455 = get_int(mkbin([255,253,7])), ?line 4245492555 = get_int(mkbin([253,13,19,75])), + ?line 4294967294 = get_int(mkbin([255,255,255,254])), + ?line 4294967295 = get_int(mkbin([255,255,255,255])), ?line Eight = [200,1,19,128,222,42,97,111], ?line cmp128(Eight, uint(Eight)), ?line fun_clause(catch get_int(mkbin(seq(1,5)))), ok. -get_int(<<I:0>>) -> I; -get_int(<<I:8>>) -> I; -get_int(<<I:16>>) -> I; -get_int(<<I:24>>) -> I; -get_int(<<I:32>>) -> I. +get_int(Bin) -> + I = get_int1(Bin), + get_int(Bin, I). + +get_int(Bin0, I) when size(Bin0) < 4 -> + Bin = <<0,Bin0/binary>>, + I = get_int1(Bin), + get_int(Bin, I); +get_int(_, I) -> I. + +get_int1(<<I:0>>) -> I; +get_int1(<<I:8>>) -> I; +get_int1(<<I:16>>) -> I; +get_int1(<<I:24>>) -> I; +get_int1(<<I:32>>) -> I. cmp128(<<I:128>>, I) -> equal; -cmp128(_B, _I) -> not_equal. +cmp128(_, _) -> not_equal. -signed_integer(suite) -> []; -signed_integer(Config) when list(Config) -> +signed_integer(Config) when is_list(Config) -> ?line {no_match,_} = sint(mkbin([])), ?line {no_match,_} = sint(mkbin([1,2,3])), ?line 127 = sint(mkbin([127])), @@ -113,7 +120,7 @@ uint(L) -> uint(L, 0). uint([H|T], Acc) -> uint(T, Acc bsl 8 bor H); uint([], Acc) -> Acc. -dynamic(Config) when list(Config) -> +dynamic(Config) when is_list(Config) -> dynamic(mkbin([255]), 8), dynamic(mkbin([255,255]), 16), dynamic(mkbin([255,255,255]), 24), @@ -124,7 +131,7 @@ dynamic(Bin, S1) when S1 >= 0 -> S2 = size(Bin) * 8 - S1, dynamic(Bin, S1, S2, (1 bsl S1) - 1, (1 bsl S2) - 1), dynamic(Bin, S1-1); -dynamic(_Bin, _) -> ok. +dynamic(_, _) -> ok. dynamic(Bin, S1, S2, A, B) -> % io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), @@ -132,25 +139,24 @@ dynamic(Bin, S1, S2, A, B) -> <<A:S1,B:S2>> -> io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), ok; - _Other -> - erlang:error(badmatch, [Bin,S1,S2,A,B]) + _Other -> erlang:error(badmatch, [Bin,S1,S2,A,B]) end. more_dynamic(doc) -> "Extract integers at different alignments and of different sizes."; -more_dynamic(Config) when list(Config) -> +more_dynamic(Config) when is_list(Config) -> % Unsigned big-endian numbers. Unsigned = fun(Bin, List, SkipBef, N) -> SkipAft = 8*size(Bin) - N - SkipBef, - <<_I1:SkipBef,Int:N,_I2:SkipAft>> = Bin, + <<_:SkipBef,Int:N,_:SkipAft>> = Bin, Int = make_int(List, N, 0) end, ?line more_dynamic1(Unsigned, funny_binary(42)), - % Signed big-endian numbers. + %% Signed big-endian numbers. Signed = fun(Bin, List, SkipBef, N) -> SkipAft = 8*size(Bin) - N - SkipBef, - <<_I1:SkipBef,Int:N/signed,_I2:SkipAft>> = Bin, + <<_:SkipBef,Int:N/signed,_:SkipAft>> = Bin, case make_signed_int(List, N) of Int -> ok; Other -> @@ -162,18 +168,18 @@ more_dynamic(Config) when list(Config) -> end, ?line more_dynamic1(Signed, funny_binary(43)), - % Unsigned little-endian numbers. + %% Unsigned little-endian numbers. UnsLittle = fun(Bin, List, SkipBef, N) -> SkipAft = 8*size(Bin) - N - SkipBef, - <<_I1:SkipBef,Int:N/little,_I2:SkipAft>> = Bin, + <<_:SkipBef,Int:N/little,_:SkipAft>> = Bin, Int = make_int(big_to_little(List, N), N, 0) end, ?line more_dynamic1(UnsLittle, funny_binary(44)), - % Signed little-endian numbers. + %% Signed little-endian numbers. SignLittle = fun(Bin, List, SkipBef, N) -> SkipAft = 8*size(Bin) - N - SkipBef, - <<_I1:SkipBef,Int:N/signed-little,_I2:SkipAft>> = Bin, + <<_:SkipBef,Int:N/signed-little,_:SkipAft>> = Bin, Little = big_to_little(List, N), Int = make_signed_int(Little, N) end, @@ -181,11 +187,6 @@ more_dynamic(Config) when list(Config) -> ok. -funny_binary(N) -> - B0 = erlang:md5([N]), - {B1,_B2} = split_binary(B0, size(B0) div 2), - B1. - more_dynamic1(Action, Bin) -> BitList = bits_to_list(binary_to_list(Bin), 16#80), more_dynamic2(Action, Bin, BitList, 0). @@ -193,7 +194,7 @@ more_dynamic1(Action, Bin) -> more_dynamic2(Action, Bin, [_|T]=List, Bef) -> more_dynamic3(Action, Bin, List, Bef, size(Bin)*8), more_dynamic2(Action, Bin, T, Bef+1); -more_dynamic2(_Action, _Bin, [], _Bef) -> ok. +more_dynamic2(_, _, [], _) -> ok. more_dynamic3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> %% io:format("~p, ~p", [Bef,Aft-Bef]), @@ -208,8 +209,8 @@ big_to_little([B0,B1,B2,B3,B4,B5,B6,B7|T], N, Acc) when N >= 8 -> big_to_little(List, N, Acc) -> lists:sublist(List, 1, N) ++ Acc. make_signed_int(_List, 0) -> 0; -make_signed_int([0|_T]=List, N) -> make_int(List, N, 0); -make_signed_int([1|_T]=List0, N) -> +make_signed_int([0|_]=List, N) -> make_int(List, N, 0); +make_signed_int([1|_]=List0, N) -> List1 = reversed_sublist(List0, N, []), List2 = two_complement_and_reverse(List1, 1, []), -make_int(List2, length(List2), 0). @@ -225,7 +226,7 @@ two_complement_and_reverse([], Carry, Acc) -> [Carry|Acc]. make_int(_List, 0, Acc) -> Acc; make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). -bits_to_list([_H|T], 0) -> bits_to_list(T, 16#80); +bits_to_list([_|T], 0) -> bits_to_list(T, 16#80); bits_to_list([H|_]=List, Mask) -> [case H band Mask of 0 -> 0; @@ -234,11 +235,134 @@ bits_to_list([H|_]=List, Mask) -> bits_to_list([], _) -> []. fun_clause({'EXIT',{function_clause,_}}) -> ok. -mkbin(L) when list(L) -> list_to_binary(L). +mkbin(L) when is_list(L) -> list_to_binary(L). + +funny_binary(N) -> + B0 = erlang:md5([N]), + {B1,_B2} = split_binary(B0, byte_size(B0) div 3), + B1. -mml(Config) when list(Config) -> +mml(Config) when is_list(Config) -> ?line single_byte_binary = mml_choose(<<42>>), ?line multi_byte_binary = mml_choose(<<42,43>>). mml_choose(<<_A:8>>) -> single_byte_binary; -mml_choose(<<_A:8, _T/binary>>) -> multi_byte_binary. +mml_choose(<<_A:8,_T/binary>>) -> multi_byte_binary. + +match_huge_int(Config) when is_list(Config) -> + Sz = 1 bsl 27, + ?line Bin = <<0:Sz,13:8>>, + ?line skip_huge_int_1(Sz, Bin), + ?line 0 = match_huge_int_1(Sz, Bin), + + %% Test overflowing the size of an integer field. + ?line nomatch = overflow_huge_int_skip_32(Bin), + case erlang:system_info(wordsize) of + 4 -> + ?line nomatch = overflow_huge_int_32(Bin); + 8 -> + %% An attempt will be made to allocate heap space for + %% the bignum (which will probably fail); only if the + %% allocation succeds will the matching fail because + %% the binary is too small. + ok + end, + ?line nomatch = overflow_huge_int_skip_64(Bin), + ?line nomatch = overflow_huge_int_64(Bin), + + %% Test overflowing the size of an integer field using variables as sizes. + ?line Sizes = case erlang:system_info(wordsize) of + 4 -> lists:seq(25, 32); + 8 -> [] + end ++ lists:seq(50, 64), + ?line ok = overflow_huge_int_unit128(Bin, Sizes), + + ok. + +overflow_huge_int_unit128(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/unit:128,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<Var:Sz/unit:128,0,_/binary>> -> + {error,Sz,Var}; + _ -> + overflow_huge_int_unit128(Bin, Sizes) + end + end; +overflow_huge_int_unit128(_, []) -> ok. + +match_huge_int_1(I, Bin) -> + <<Int:I,13>> = Bin, + Int. + +skip_huge_int_1(I, Bin) -> + <<_:I,13>> = Bin. + +overflow_huge_int_skip_32(<<_:4294967296,0,_/binary>>) -> 1; % 1 bsl 32 +overflow_huge_int_skip_32(<<_:33554432/unit:128,0,_/binary>>) -> 2; % 1 bsl 25 +overflow_huge_int_skip_32(<<_:67108864/unit:64,0,_/binary>>) -> 3; % 1 bsl 26 +overflow_huge_int_skip_32(<<_:134217728/unit:32,0,_/binary>>) -> 4; % 1 bsl 27 +overflow_huge_int_skip_32(<<_:268435456/unit:16,0,_/binary>>) -> 5; % 1 bsl 28 +overflow_huge_int_skip_32(<<_:536870912/unit:8,0,_/binary>>) -> 6; % 1 bsl 29 +overflow_huge_int_skip_32(<<_:1073741824/unit:8,0,_/binary>>) -> 7; % 1 bsl 30 +overflow_huge_int_skip_32(<<_:2147483648/unit:8,0,_/binary>>) -> 8; % 1 bsl 31 +overflow_huge_int_skip_32(_) -> nomatch. + +overflow_huge_int_32(<<Int:4294967296,_/binary>>) -> {1,Int}; % 1 bsl 32 +overflow_huge_int_32(<<Int:33554432/unit:128,0,_/binary>>) -> {2,Int}; % 1 bsl 25 +overflow_huge_int_32(<<Int:67108864/unit:128,0,_/binary>>) -> {3,Int}; % 1 bsl 26 +overflow_huge_int_32(<<Int:134217728/unit:128,0,_/binary>>) -> {4,Int}; % 1 bsl 27 +overflow_huge_int_32(<<Int:268435456/unit:128,0,_/binary>>) -> {5,Int}; % 1 bsl 28 +overflow_huge_int_32(<<Int:536870912/unit:128,0,_/binary>>) -> {6,Int}; % 1 bsl 29 +overflow_huge_int_32(<<Int:1073741824/unit:128,0,_/binary>>) -> {7,Int}; % 1 bsl 30 +overflow_huge_int_32(<<Int:2147483648/unit:128,0,_/binary>>) -> {8,Int}; % 1 bsl 31 +overflow_huge_int_32(_) -> nomatch. + +overflow_huge_int_skip_64(<<_:18446744073709551616,_/binary>>) -> 1; % 1 bsl 64 +overflow_huge_int_skip_64(<<_:144115188075855872/unit:128,0,_/binary>>) -> 2; % 1 bsl 57 +overflow_huge_int_skip_64(<<_:288230376151711744/unit:64,0,_/binary>>) -> 3; % 1 bsl 58 +overflow_huge_int_skip_64(<<_:576460752303423488/unit:32,0,_/binary>>) -> 4; % 1 bsl 59 +overflow_huge_int_skip_64(<<_:1152921504606846976/unit:16,0,_/binary>>) -> 5; % 1 bsl 60 +overflow_huge_int_skip_64(<<_:2305843009213693952/unit:8,0,_/binary>>) -> 6; % 1 bsl 61 +overflow_huge_int_skip_64(<<_:4611686018427387904/unit:8,0,_/binary>>) -> 7; % 1 bsl 62 +overflow_huge_int_skip_64(<<_:9223372036854775808/unit:8,0,_/binary>>) -> 8; % 1 bsl 63 +overflow_huge_int_skip_64(_) -> nomatch. + +overflow_huge_int_64(<<Int:18446744073709551616,_/binary>>) -> {1,Int}; % 1 bsl 64 +overflow_huge_int_64(<<Int:144115188075855872/unit:128,0,_/binary>>) -> {2,Int}; % 1 bsl 57 +overflow_huge_int_64(<<Int:288230376151711744/unit:128,0,_/binary>>) -> {3,Int}; % 1 bsl 58 +overflow_huge_int_64(<<Int:576460752303423488/unit:128,0,_/binary>>) -> {4,Int}; % 1 bsl 59 +overflow_huge_int_64(<<Int:1152921504606846976/unit:128,0,_/binary>>) -> {5,Int}; % 1 bsl 60 +overflow_huge_int_64(<<Int:2305843009213693952/unit:128,0,_/binary>>) -> {6,Int}; % 1 bsl 61 +overflow_huge_int_64(<<Int:4611686018427387904/unit:128,0,_/binary>>) -> {7,Int}; % 1 bsl 62 +overflow_huge_int_64(<<Int:9223372036854775808/unit:128,0,_/binary>>) -> {8,Int}; % 1 bsl 63 +overflow_huge_int_64(_) -> nomatch. + +bignum(Config) when is_list(Config) -> + ?line Bin = id(<<42,0:1024/unit:8,43>>), + ?line <<42:1025/little-integer-unit:8,_:8>> = Bin, + ?line <<_:8,43:1025/integer-unit:8>> = Bin, + + ?line BignumBin = id(<<0:512/unit:8,258254417031933722623:9/unit:8>>), + ?line <<258254417031933722623:(512+9)/unit:8>> = BignumBin, + erlang:garbage_collect(), %Search for holes in debug-build. + ok. + +unaligned_32_bit(Config) when is_list(Config) -> + %% There used to be a risk for heap overflow (fixed in R11B-5). + ?line L = unaligned_32_bit_1(<<-1:(64*1024)>>), + ?line unaligned_32_bit_verify(L, 1638). + +unaligned_32_bit_1(<<1:1,U:32,_:7,T/binary>>) -> + [U|unaligned_32_bit_1(T)]; +unaligned_32_bit_1(_) -> + []. + +unaligned_32_bit_verify([], 0) -> ok; +unaligned_32_bit_verify([4294967295|T], N) when N > 0 -> + unaligned_32_bit_verify(T, N-1). + +id(I) -> I. diff --git a/lib/debugger/test/bs_match_misc_SUITE.erl b/lib/debugger/test/bs_match_misc_SUITE.erl index 53d11ba179..89fce263f5 100644 --- a/lib/debugger/test/bs_match_misc_SUITE.erl +++ b/lib/debugger/test/bs_match_misc_SUITE.erl @@ -19,18 +19,24 @@ -module(bs_match_misc_SUITE). --author('[email protected]'). -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, - bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1]). + bound_var/1,bound_tail/1,t_float/1,little_float/1,sean/1, + kenneth/1,encode_binary/1,native/1,happi/1, + size_var/1,wiger/1,x0_context/1,huge_float_field/1, + writable_binary_matched/1,otp_7198/1, + unordered_bindings/1]). -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - cases(). + [bound_var, bound_tail, t_float, little_float, sean, + kenneth, encode_binary, native, happi, size_var, wiger, + x0_context, huge_float_field, writable_binary_matched, + otp_7198, unordered_bindings]. groups() -> []. @@ -41,9 +47,13 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_suite(Config) when is_list(Config) -> + ?line test_lib:interpret(?MODULE), + ?line true = lists:member(?MODULE, int:interpreted()), + Config. -cases() -> - [bound_var, bound_tail, t_float, little_float, sean]. +end_per_suite(Config) when is_list(Config) -> + ok. init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), @@ -55,16 +65,8 @@ end_per_testcase(_Case, Config) -> ?t:timetrap_cancel(Dog), ok. -init_per_suite(Config) when is_list(Config) -> - ?line test_lib:interpret(?MODULE), - ?line true = lists:member(?MODULE, int:interpreted()), - Config. - -end_per_suite(Config) when is_list(Config) -> - ok. - bound_var(doc) -> "Test matching of bound variables."; -bound_var(Config) when list(Config) -> +bound_var(Config) when is_list(Config) -> ?line ok = bound_var(42, 13, <<42,13>>), ?line nope = bound_var(42, 13, <<42,255>>), ?line nope = bound_var(42, 13, <<154,255>>), @@ -74,7 +76,7 @@ bound_var(A, B, <<A:8,B:8>>) -> ok; bound_var(_, _, _) -> nope. bound_tail(doc) -> "Test matching of a bound tail."; -bound_tail(Config) when list(Config) -> +bound_tail(Config) when is_list(Config) -> ?line ok = bound_tail(<<>>, <<13,14>>), ?line ok = bound_tail(<<2,3>>, <<1,1,2,3>>), ?line nope = bound_tail(<<2,3>>, <<1,1,2,7>>), @@ -85,7 +87,7 @@ bound_tail(Config) when list(Config) -> bound_tail(T, <<_:16,T/binary>>) -> ok; bound_tail(_, _) -> nope. -t_float(Config) when list(Config) -> +t_float(Config) when is_list(Config) -> F = f1(), G = f_one(), @@ -98,6 +100,10 @@ t_float(Config) when list(Config) -> ?line fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), ?line fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)), ?line fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), + + ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16, 0)), + ?line {'EXIT',{{badmatch,_},_}} = (catch match_float(<<0,0>>, 16#7fffffff, 0)), + ok. @@ -110,7 +116,7 @@ match_float(Bin0, Fsz, I) -> <<_:I,F:Fsz/float,_:Tsz>> = Bin, F. -little_float(Config) when list(Config) -> +little_float(Config) when is_list(Config) -> F = f2(), G = f_one(), @@ -149,7 +155,7 @@ f2() -> f_one() -> 1.0. -sean(Config) when list(Config) -> +sean(Config) when is_list(Config) -> ?line small = sean1(<<>>), ?line small = sean1(<<1>>), ?line small = sean1(<<1,2>>), @@ -162,5 +168,414 @@ sean(Config) when list(Config) -> ?line {'EXIT',{function_clause,_}} = (catch sean1(<<4,5,6,7>>)), ok. -sean1(<<B/binary>>) when size(B) < 4 -> small; +sean1(<<B/binary>>) when byte_size(B) < 4 -> small; sean1(<<1, _B/binary>>) -> large. + +kenneth(Config) when is_list(Config) -> + {ok,[145,148,113,129,0,0,0,0]} = + msisdn_internal_storage(<<145,148,113,129,0,0,0,0>>, []). + +msisdn_internal_storage(<<>>,MSISDN) -> + {ok,lists:reverse(MSISDN)}; +msisdn_internal_storage(<<2#11111111:8,_Rest/binary>>,MSISDN) -> + {ok,lists:reverse(MSISDN)}; +msisdn_internal_storage(<<2#1111:4,DigitN:4,_Rest/binary>>,MSISDN) when + DigitN < 10 -> + {ok,lists:reverse([(DigitN bor 2#11110000)|MSISDN])}; +msisdn_internal_storage(<<DigitNplus1:4,DigitN:4,Rest/binary>>,MSISDN) when + DigitNplus1 < 10, + DigitN < 10 -> + NewMSISDN=[((DigitNplus1 bsl 4) bor DigitN)|MSISDN], + msisdn_internal_storage(Rest,NewMSISDN); +msisdn_internal_storage(_Rest,_MSISDN) -> + {fault}. %% Mandatory IE incorrect + +encode_binary(Config) when is_list(Config) -> + "C2J2QiSc" = encodeBinary(<<11,98,118,66,36,156>>, []), + ok. + +encodeBinary(<<>>, Output) -> + lists:reverse(Output); +encodeBinary(<<Data:1/binary>>, Output) -> + <<DChar1:6, DChar2:2>> = Data, + Char1 = getBase64Char(DChar1), + Char2 = getBase64Char(DChar2), + Char3 = "=", + Char4 = "=", + NewOutput = Char4 ++ Char3 ++ Char2 ++ Char1 ++ Output, + encodeBinary(<<>>, NewOutput); +encodeBinary(<<Data:2/binary>>, Output) -> + <<DChar1:6, DChar2:6, DChar3:4>> = Data, + Char1 = getBase64Char(DChar1), + Char2 = getBase64Char(DChar2), + Char3 = getBase64Char(DChar3), + Char4 = "=", + NewOutput = Char4 ++ Char3 ++ Char2 ++ Char1 ++ Output, + encodeBinary(<<>>, NewOutput); +encodeBinary(<<Data:3/binary, Rest/binary>>, Output) -> + <<DChar1:6, DChar2:6, DChar3:6, DChar4:6>> = Data, + Char1 = getBase64Char(DChar1), + Char2 = getBase64Char(DChar2), + Char3 = getBase64Char(DChar3), + Char4 = getBase64Char(DChar4), + NewOutput = Char4 ++ Char3 ++ Char2 ++ Char1 ++ Output, + encodeBinary(Rest, NewOutput); +encodeBinary(_Data, _) -> + error. + +getBase64Char(0) -> "A"; +getBase64Char(1) -> "B"; +getBase64Char(2) -> "C"; +getBase64Char(3) -> "D"; +getBase64Char(4) -> "E"; +getBase64Char(5) -> "F"; +getBase64Char(6) -> "G"; +getBase64Char(7) -> "H"; +getBase64Char(8) -> "I"; +getBase64Char(9) -> "J"; +getBase64Char(10) -> "K"; +getBase64Char(11) -> "L"; +getBase64Char(12) -> "M"; +getBase64Char(13) -> "N"; +getBase64Char(14) -> "O"; +getBase64Char(15) -> "P"; +getBase64Char(16) -> "Q"; +getBase64Char(17) -> "R"; +getBase64Char(18) -> "S"; +getBase64Char(19) -> "T"; +getBase64Char(20) -> "U"; +getBase64Char(21) -> "V"; +getBase64Char(22) -> "W"; +getBase64Char(23) -> "X"; +getBase64Char(24) -> "Y"; +getBase64Char(25) -> "Z"; +getBase64Char(26) -> "a"; +getBase64Char(27) -> "b"; +getBase64Char(28) -> "c"; +getBase64Char(29) -> "d"; +getBase64Char(30) -> "e"; +getBase64Char(31) -> "f"; +getBase64Char(32) -> "g"; +getBase64Char(33) -> "h"; +getBase64Char(34) -> "i"; +getBase64Char(35) -> "j"; +getBase64Char(36) -> "k"; +getBase64Char(37) -> "l"; +getBase64Char(38) -> "m"; +getBase64Char(39) -> "n"; +getBase64Char(40) -> "o"; +getBase64Char(41) -> "p"; +getBase64Char(42) -> "q"; +getBase64Char(43) -> "r"; +getBase64Char(44) -> "s"; +getBase64Char(45) -> "t"; +getBase64Char(46) -> "u"; +getBase64Char(47) -> "v"; +getBase64Char(48) -> "w"; +getBase64Char(49) -> "x"; +getBase64Char(50) -> "y"; +getBase64Char(51) -> "z"; +getBase64Char(52) -> "0"; +getBase64Char(53) -> "1"; +getBase64Char(54) -> "2"; +getBase64Char(55) -> "3"; +getBase64Char(56) -> "4"; +getBase64Char(57) -> "5"; +getBase64Char(58) -> "6"; +getBase64Char(59) -> "7"; +getBase64Char(60) -> "8"; +getBase64Char(61) -> "9"; +getBase64Char(62) -> "+"; +getBase64Char(63) -> "/"; +getBase64Char(_Else) -> + %% This is an illegal input. +% cgLogEM:log(error, ?MODULE, getBase64Char, [Else], +% "illegal input", +% ?LINE, version()), + "**". + +-define(M(F), <<F>> = <<F>>). + +native(Config) when is_list(Config) -> + ?line ?M(3.14:64/native-float), + ?line ?M(333:16/native), + ?line ?M(38658345:32/native), + case <<1:16/native>> of + <<0,1>> -> native_big(); + <<1,0>> -> native_little() + end. + +native_big() -> + ?line <<37.33:64/native-float>> = <<37.33:64/big-float>>, + ?line <<3974:16/native-integer>> = <<3974:16/big-integer>>, + {comment,"Big endian"}. + +native_little() -> + ?line <<37869.32343:64/native-float>> = <<37869.32343:64/little-float>>, + ?line <<7974:16/native-integer>> = <<7974:16/little-integer>>, + {comment,"Little endian"}. + +happi(Config) when is_list(Config) -> + Bin = <<".123">>, + ?line <<"123">> = lex_digits1(Bin, 1, []), + ?line <<"123">> = lex_digits2(Bin, 1, []), + ok. + +lex_digits1(<<$., Rest/binary>>,_Val,_Acc) -> + Rest; +lex_digits1(<<N, Rest/binary>>,Val, Acc) when N >= $0 , N =< $9 -> + lex_digits1(Rest,Val*10+dec(N),Acc); +lex_digits1(_Other,_Val,_Acc) -> + not_ok. + +lex_digits2(<<N, Rest/binary>>,Val, Acc) when N >= $0 , N =< $9 -> + lex_digits2(Rest,Val*10+dec(N),Acc); +lex_digits2(<<$., Rest/binary>>,_Val,_Acc) -> + Rest; +lex_digits2(_Other,_Val,_Acc) -> + not_ok. + +dec(A) -> + A-$0. + +size_var(Config) when is_list(Config) -> + ?line {<<45>>,<<>>} = split(<<1:16,45>>), + ?line {<<45>>,<<46,47>>} = split(<<1:16,45,46,47>>), + ?line {<<45,46>>,<<47>>} = split(<<2:16,45,46,47>>), + + ?line {<<45,46,47>>,<<48>>} = split_2(<<16:8,3:16,45,46,47,48>>), + + ?line {<<45,46>>,<<47>>} = split(2, <<2:16,45,46,47>>), + ?line {'EXIT',{function_clause,_}} = (catch split(42, <<2:16,45,46,47>>)), + + ?line <<"cdef">> = skip(<<2:8,"abcdef">>), + + ok. + +split(<<N:16,B:N/binary,T/binary>>) -> + {B,T}. + +split(N, <<N:16,B:N/binary,T/binary>>) -> + {B,T}. + +split_2(<<N0:8,N:N0,B:N/binary,T/binary>>) -> + {B,T}. + +skip(<<N:8,_:N/binary,T/binary>>) -> T. + +wiger(Config) when is_list(Config) -> + ?line ok1 = wcheck(<<3>>), + ?line ok2 = wcheck(<<1,2,3>>), + ?line ok3 = wcheck(<<4>>), + ?line {error,<<1,2,3,4>>} = wcheck(<<1,2,3,4>>), + ?line {error,<<>>} = wcheck(<<>>), + ok. + +wcheck(<<A>>) when A==3-> + ok1; +wcheck(<<_,_:2/binary>>) -> + ok2; +wcheck(<<_>>) -> + ok3; +wcheck(Other) -> + {error,Other}. + +%% Test that having the match context in x(0) works. + +x0_context(Config) when is_list(Config) -> + x0_0([], <<3.0:64/float,42:16,123456:32>>). + +x0_0(_, Bin) -> + <<3.0:64/float,42:16,_/binary>> = Bin, + x0_1([], Bin, 64, 16, 2). + +x0_1(_, Bin, FloatSz, IntSz, BinSz) -> + <<_:FloatSz/float,42:IntSz,B:BinSz/binary,C:1/binary,D/binary>> = Bin, + id({B,C,D}), + <<_:FloatSz/float,42:IntSz,B:BinSz/binary,_/binary>> = Bin, + x0_2([], Bin). + +x0_2(_, Bin) -> + <<_:64,0:7,42:9,_/binary>> = Bin, + x0_3([], Bin). + +x0_3(_, Bin) -> + case Bin of + <<_:72,7:8,_/binary>> -> + ?line ?t:fail(); + <<_:64,0:16,_/binary>> -> + ?line ?t:fail(); + <<_:64,42:16,123456:32,_/binary>> -> + ok + end. + + +huge_float_field(Config) when is_list(Config) -> + Sz = 1 bsl 27, + ?line Bin = <<0:Sz>>, + + ?line nomatch = overflow_huge_float_skip_32(Bin), + ?line nomatch = overflow_huge_float_32(Bin), + + ?line ok = overflow_huge_float(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ?line ok = overflow_huge_float_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok. + +overflow_huge_float_skip_32(<<_:4294967296/float,0,_/binary>>) -> 1; % 1 bsl 32 +overflow_huge_float_skip_32(<<_:33554432/float-unit:128,0,_/binary>>) -> 2; % 1 bsl 25 +overflow_huge_float_skip_32(<<_:67108864/float-unit:64,0,_/binary>>) -> 3; % 1 bsl 26 +overflow_huge_float_skip_32(<<_:134217728/float-unit:32,0,_/binary>>) -> 4; % 1 bsl 27 +overflow_huge_float_skip_32(<<_:268435456/float-unit:16,0,_/binary>>) -> 5; % 1 bsl 28 +overflow_huge_float_skip_32(<<_:536870912/float-unit:8,0,_/binary>>) -> 6; % 1 bsl 29 +overflow_huge_float_skip_32(<<_:1073741824/float-unit:8,0,_/binary>>) -> 7; % 1 bsl 30 +overflow_huge_float_skip_32(<<_:2147483648/float-unit:8,0,_/binary>>) -> 8; % 1 bsl 31 +overflow_huge_float_skip_32(_) -> nomatch. + +overflow_huge_float_32(<<F:4294967296/float,_/binary>>) -> {1,F}; % 1 bsl 32 +overflow_huge_float_32(<<F:33554432/float-unit:128,0,_/binary>>) -> {2,F}; % 1 bsl 25 +overflow_huge_float_32(<<F:67108864/float-unit:128,0,_/binary>>) -> {3,F}; % 1 bsl 26 +overflow_huge_float_32(<<F:134217728/float-unit:128,0,_/binary>>) -> {4,F}; % 1 bsl 27 +overflow_huge_float_32(<<F:268435456/float-unit:128,0,_/binary>>) -> {5,F}; % 1 bsl 28 +overflow_huge_float_32(<<F:536870912/float-unit:128,0,_/binary>>) -> {6,F}; % 1 bsl 29 +overflow_huge_float_32(<<F:1073741824/float-unit:128,0,_/binary>>) -> {7,F}; % 1 bsl 30 +overflow_huge_float_32(<<F:2147483648/float-unit:128,0,_/binary>>) -> {8,F}; % 1 bsl 31 +overflow_huge_float_32(_) -> nomatch. + + +overflow_huge_float(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/float-unit:8,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<Var:Sz/float-unit:8,0,_/binary>> -> + {error,Sz,Var}; + _ -> + overflow_huge_float(Bin, Sizes) + end + end; +overflow_huge_float(_, []) -> ok. + +overflow_huge_float_unit128(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/float-unit:128,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<Var:Sz/float-unit:128,0,_/binary>> -> + {error,Sz,Var}; + _ -> + overflow_huge_float_unit128(Bin, Sizes) + end + end; +overflow_huge_float_unit128(_, []) -> ok. + + +%% +%% Test that a writable binary can be safely matched. +%% + +writable_binary_matched(Config) when is_list(Config) -> + ?line WritableBin = create_writeable_binary(), + ?line writable_binary_matched(WritableBin, WritableBin, 500). + +writable_binary_matched(<<0>>, _, N) -> + if + N =:= 0 -> ok; + true -> + put(grow_heap, [N|get(grow_heap)]), + ?line WritableBin = create_writeable_binary(), + ?line writable_binary_matched(WritableBin, WritableBin, N-1) + end; +writable_binary_matched(<<B:8,T/binary>>, WritableBin0, N) -> + ?line WritableBin = writable_binary(WritableBin0, B), + writable_binary_matched(T, WritableBin, N). + +writable_binary(WritableBin0, B) when is_binary(WritableBin0) -> + %% Heavy append to force the binary to move. + ?line WritableBin = <<WritableBin0/binary,0:(size(WritableBin0))/unit:8,B>>, + ?line id(<<(id(0)):128/unit:8>>), + WritableBin. + +create_writeable_binary() -> + <<(id(<<>>))/binary,1,2,3,4,5,6,0>>. + +otp_7198(Config) when is_list(Config) -> + %% When a match context was reused, and grown at the same time to + %% increase the number of saved positions, the thing word was not updated + %% to account for the new size. Therefore, if there was a garbage collection, + %% the new slots would be included in the garbage collection. + ?line [do_otp_7198(FillerSize) || FillerSize <- lists:seq(0, 256)], + ok. + +do_otp_7198(FillerSize) -> + Filler = erlang:make_tuple(FillerSize, 42), + {Pid,Ref} = spawn_monitor(fun() -> do_otp_7198_test(Filler) end), + receive + {'DOWN',Ref,process,Pid,normal} -> + ok; + {'DOWN',Ref,process,Pid,Reason} -> + io:format("unexpected: ~p", [Reason]), + ?line ?t:fail() + end. + +do_otp_7198_test(_) -> + [{'KEYWORD',114}, + {'KEYWORD',101}, + {'KEYWORD',103}, + {'KEYWORD',105}, + {'KEYWORD',111}, + {'FIELD',110}, + {'KEYWORD',119}, + {'KEYWORD',104}, + {'KEYWORD',97}, + {'KEYWORD',116}, + {'KEYWORD',101}, + {'KEYWORD',118}, + {'KEYWORD',101}, + {'KEYWORD',114}, + '$thats_all_folks$'] = otp_7198_scan(<<"region:whatever">>, []). + + +otp_7198_scan(<<>>, TokAcc) -> + lists:reverse(['$thats_all_folks$' | TokAcc]); + +otp_7198_scan(<<D, Z, Rest/binary>>, TokAcc) when + (D =:= $D orelse D =:= $d) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + otp_7198_scan(<<Z, Rest/binary>>, ['AND' | TokAcc]); + +otp_7198_scan(<<D>>, TokAcc) when + (D =:= $D) or (D =:= $d) -> + otp_7198_scan(<<>>, ['AND' | TokAcc]); + +otp_7198_scan(<<N, Z, Rest/binary>>, TokAcc) when + (N =:= $N orelse N =:= $n) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + otp_7198_scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]); + +otp_7198_scan(<<C, Rest/binary>>, TokAcc) when + (C >= $A) and (C =< $Z); + (C >= $a) and (C =< $z); + (C >= $0) and (C =< $9) -> + case Rest of + <<$:, R/binary>> -> + otp_7198_scan(R, [{'FIELD', C} | TokAcc]); + _ -> + otp_7198_scan(Rest, [{'KEYWORD', C} | TokAcc]) + end. + +unordered_bindings(Config) when is_list(Config) -> + {<<1,2,3,4>>,<<42,42>>,<<3,3,3>>} = + unordered_bindings(4, 2, 3, <<1,2,3,4, 42,42, 3,3,3, 3>>), + ok. + +unordered_bindings(CompressedLength, HashSize, PadLength, T) -> + <<Content:CompressedLength/binary,Mac:HashSize/binary, + Padding:PadLength/binary,PadLength>> = T, + {Content,Mac,Padding}. + + +id(I) -> I. diff --git a/lib/debugger/test/bs_match_tail_SUITE.erl b/lib/debugger/test/bs_match_tail_SUITE.erl index 961ccbb599..9f7519cf3a 100644 --- a/lib/debugger/test/bs_match_tail_SUITE.erl +++ b/lib/debugger/test/bs_match_tail_SUITE.erl @@ -64,7 +64,7 @@ end_per_suite(Config) when is_list(Config) -> ok. aligned(doc) -> "Test aligned tails."; -aligned(Config) when list(Config) -> +aligned(Config) when is_list(Config) -> ?line Tail1 = mkbin([]), ?line {258,Tail1} = al_get_tail_used(mkbin([1,2])), ?line Tail2 = mkbin(lists:seq(1, 127)), @@ -84,10 +84,10 @@ aligned(Config) when list(Config) -> ok. al_get_tail_used(<<A:16,T/binary>>) -> {A,T}. -al_get_tail_unused(<<A:16,_T/binary>>) -> A. +al_get_tail_unused(<<A:16,_/binary>>) -> A. unaligned(doc) -> "Test that an non-aligned tail cannot be matched out."; -unaligned(Config) when list(Config) -> +unaligned(Config) when is_list(Config) -> ?line {'EXIT',{function_clause,_}} = (catch get_tail_used(mkbin([42]))), ?line {'EXIT',{{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)), ?line {'EXIT',{function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))), @@ -103,11 +103,11 @@ get_dyn_tail_used(Bin, Sz) -> {A,T}. get_dyn_tail_unused(Bin, Sz) -> - <<A:Sz,_T/binary>> = Bin, + <<A:Sz,_/binary>> = Bin, A. zero_tail(doc) -> "Test that zero tails are tested correctly."; -zero_tail(Config) when list(Config) -> +zero_tail(Config) when is_list(Config) -> ?line 7 = (catch test_zero_tail(mkbin([7]))), ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail(mkbin([1,2]))), ?line {'EXIT',{function_clause,_}} = (catch test_zero_tail2(mkbin([1,2,3]))), @@ -117,4 +117,4 @@ test_zero_tail(<<A:8>>) -> A. test_zero_tail2(<<_A:4,_B:4>>) -> ok. -mkbin(L) when list(L) -> list_to_binary(L). +mkbin(L) when is_list(L) -> list_to_binary(L). diff --git a/lib/debugger/test/bug_SUITE.erl b/lib/debugger/test/bug_SUITE.erl index a831897dfb..1a7e876329 100644 --- a/lib/debugger/test/bug_SUITE.erl +++ b/lib/debugger/test/bug_SUITE.erl @@ -51,7 +51,7 @@ end_per_group(_GroupName, Config) -> otp2163(doc) -> ["BIF exit reason"]; otp2163(suite) -> []; -otp2163(Config) when list(Config) -> +otp2163(Config) when is_list(Config) -> ?line DataDir = ?config(data_dir, Config), %% First compile and get the expected results: @@ -74,7 +74,7 @@ otp2163(Config) when list(Config) -> otp4845(doc) -> ["BIF not loading and not bug compatible, OTP-4845 OTP-4859"]; otp4845(suite) -> []; -otp4845(Config) when list(Config) -> +otp4845(Config) when is_list(Config) -> ?line DataDir = ?config(data_dir, Config), %% First compile and get the expected results: diff --git a/lib/debugger/test/exception_SUITE.erl b/lib/debugger/test/exception_SUITE.erl index 8c864e4b5f..86554ab2d4 100644 --- a/lib/debugger/test/exception_SUITE.erl +++ b/lib/debugger/test/exception_SUITE.erl @@ -23,7 +23,8 @@ -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, - badmatch/1,pending_errors/1,nil_arith/1]). + badmatch/1,pending_errors/1,nil_arith/1, + stacktrace/1,nested_stacktrace/1,raise/1,gunilla/1,per/1]). -export([bad_guy/2]). @@ -31,6 +32,19 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. +%% Filler. +%% +%% +%% +%% +%% This is line 40. +even(N) when is_integer(N), N > 1, (N rem 2) == 0 -> + odd(N-1)++[N]. + +odd(N) when is_integer(N), N > 1, (N rem 2) == 1 -> + even(N-1)++[N]. + + all() -> cases(). @@ -45,7 +59,8 @@ end_per_group(_GroupName, Config) -> cases() -> - [badmatch, pending_errors, nil_arith]. + [badmatch, pending_errors, nil_arith, stacktrace, + nested_stacktrace, raise, gunilla, per]. -define(try_match(E), catch ?MODULE:bar(), @@ -69,9 +84,9 @@ init_per_suite(Config) when is_list(Config) -> end_per_suite(Config) when is_list(Config) -> ok. -badmatch(doc) -> "Test that deliberately bad matches are reported correctly."; -badmatch(suite) -> []; -badmatch(Config) when list(Config) -> +%% Test that deliberately bad matches are reported correctly. + +badmatch(Config) when is_list(Config) -> ?line ?try_match(a), ?line ?try_match(42), ?line ?try_match({a, b, c}), @@ -79,11 +94,9 @@ badmatch(Config) when list(Config) -> ?line ?try_match(1.0), ok. -pending_errors(doc) -> - ["Test various exceptions, in the presence of a previous error suppressed ", - "in a guard."]; -pending_errors(suite) -> []; -pending_errors(Config) when list(Config) -> +%% Test various exceptions, in the presence of a previous error suppressed +%% in a guard. +pending_errors(Config) when is_list(Config) -> ?line pending(e_badmatch, {badmatch, b}), ?line pending(x, function_clause), ?line pending(e_case, {case_clause, xxx}), @@ -100,7 +113,7 @@ bad_guy(pe_badarith, Other) when Other+1 == 0 -> % badarith (suppressed) bad_guy(pe_badarg, Other) when length(Other) > 0 -> % badarg (suppressed) ok; bad_guy(_, e_case) -> - case xxx of + case id(xxx) of ok -> ok end; % case_clause bad_guy(_, e_if) -> @@ -121,7 +134,7 @@ bad_guy(_, e_badarg) -> bad_guy(_, e_badarg_spawn) -> spawn({}, {}, {}); % badarg bad_guy(_, e_badmatch) -> - a = b. % badmatch + a = id(b). % badmatch pending(Arg, Expected) -> pending(pe_badarith, Arg, Expected), @@ -155,28 +168,23 @@ pending_exit_message(Args, Expected) -> end, process_flag(trap_exit, false). -pending({badarg,[{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]}, Func, Args, _Code) - when atom(Bif), list(BifArgs), length(Args) == Arity -> %Threaded code. - ok; -pending({badarg,[{erlang,Bif,BifArgs},{?MODULE,Func,Args}|_]}, Func, Args, _Code) - when atom(Bif), list(BifArgs) -> %From interpreted code. +pending({badarg, [{erlang,Bif,BifArgs,_},{?MODULE,Func,Arity,_}|_]}, + Func, Args, _Code) + when is_atom(Bif), is_list(BifArgs), length(Args) == Arity -> ok; -pending({undef,[{non_existing_module,foo,[]}|_]}, _, _, _) -> +pending({undef,[{non_existing_module,foo,[],_}|_]}, _, _, _) -> ok; -pending({function_clause,[{?MODULE,Func,Args}|_]}, Func, Args, _Code) -> +pending({function_clause,[{?MODULE,Func,Args,_}|_]}, Func, Args, _Code) -> ok; -pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code) when length(Args) == Arity -> %Threaded code +pending({Code,[{?MODULE,Func,Arity,_}|_]}, Func, Args, Code) + when length(Args) == Arity -> ok; -pending({Code,[{?MODULE,Func,Args}|_]}, Func, Args, Code) -> %From interpreted code. - ok; -pending(Reason, Func, Args, Code) -> - test_server:fail({bad_exit_reason,Reason,{Func,Args,Code}}). - -nil_arith(doc) -> - "Test that doing arithmetics on [] gives a badarith EXIT and not a crash."; -nil_arith(suite) -> - []; -nil_arith(Config) when list(Config) -> +pending(Reason, _Function, _Args, _Code) -> + test_server:fail({bad_exit_reason,Reason}). + +%% Test that doing arithmetics on [] gives a badarith EXIT and not a crash. + +nil_arith(Config) when is_list(Config) -> ?line ba_plus_minus_times([], []), ?line ba_plus_minus_times([], 0), @@ -268,3 +276,199 @@ ba_shift(A, B) -> ba_bnot(A) -> io:format("bnot ~p", [A]), {'EXIT', {badarith, _}} = (catch bnot A). + +stacktrace(Conf) when is_list(Conf) -> + Tag = make_ref(), + ?line {_,Mref} = spawn_monitor(fun() -> exit({Tag,erlang:get_stacktrace()}) end), + ?line {Tag,[]} = receive {'DOWN',Mref,_,_,Info} -> Info end, + V = [make_ref()|self()], + ?line {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]=St1}} = + stacktrace_1({'abs',V}, error, {value,V}), + ?line St1 = erase(stacktrace1), + ?line St1 = erase(stacktrace2), + ?line St1 = erlang:get_stacktrace(), + ?line {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]=St2} = + stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}), + ?line [{?MODULE,my_div,2,_}|_] = erase(stacktrace1), + ?line St2 = erase(stacktrace2), + ?line St2 = erlang:get_stacktrace(), + ?line {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]=St3} = + stacktrace_1({value,V}, error, {value,V}), + ?line St3 = erase(stacktrace1), + ?line St3 = erase(stacktrace2), + ?line St3 = erlang:get_stacktrace(), + ?line {caught2,{throw,V},[{?MODULE,foo,1,_}|_]=St4} = + stacktrace_1({value,V}, error, {throw,V}), + ?line [{?MODULE,stacktrace_1,3,_}|_] = erase(stacktrace1), + ?line St4 = erase(stacktrace2), + ?line St4 = erlang:get_stacktrace(), + ok. + +stacktrace_1(X, C1, Y) -> + erase(stacktrace1), + erase(stacktrace2), + try try foo(X) of + C1 -> value1 + catch + C1:D1 -> {caught1,D1,erlang:get_stacktrace()} + after + put(stacktrace1, erlang:get_stacktrace()), + foo(Y) + end of + V2 -> {value2,V2} + catch + C2:D2 -> {caught2,{C2,D2},erlang:get_stacktrace()} + after + put(stacktrace2, erlang:get_stacktrace()) + end. + + + +nested_stacktrace(Conf) when is_list(Conf) -> + V = [{make_ref()}|[self()]], + ?line value1 = + nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, + {void,void,void}), + ?line {caught1, + [{?MODULE,my_add,2,_}|_], + value2, + [{?MODULE,my_add,2,_}|_]} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{value,{V,x2}},void,{V,x2}}), + ?line {caught1, + [{?MODULE,my_add,2,_}|_], + {caught2,[{erlang,abs,[V],_}|_]}, + [{erlang,abs,[V],_}|_]} = + nested_stacktrace_1({{'add',{V,x1}},error,badarith}, + {{'abs',V},error,badarg}), + ok. + +nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> + try foo(X1) of + V1 -> value1 + catch + C1:V1 -> + S1 = erlang:get_stacktrace(), + T2 = + try foo(X2) of + V2 -> value2 + catch + C2:V2 -> {caught2,erlang:get_stacktrace()} + end, + {caught1,S1,T2,erlang:get_stacktrace()} + end. + + + +raise(Conf) when is_list(Conf) -> + ?line erase(raise), + ?line A = + try + ?line try foo({'div',{1,0}}) + catch + error:badarith -> + put(raise, A0 = erlang:get_stacktrace()), + ?line erlang:raise(error, badarith, A0) + end + catch + error:badarith -> + ?line A1 = erlang:get_stacktrace(), + ?line A1 = get(raise) + end, + ?line A = erlang:get_stacktrace(), + ?line A = get(raise), + ?line [{?MODULE,my_div,2,_}|_] = A, + %% + N = 8, % Must be even + ?line N = erlang:system_flag(backtrace_depth, N), + ?line try even(N) + catch error:function_clause -> ok + end, + ?line B = odd_even(N, []), + ?line B = erlang:get_stacktrace(), + %% + ?line C0 = odd_even(N+1, []), + ?line C = lists:sublist(C0, N), + ?line try odd(N+1) + catch error:function_clause -> ok + end, + ?line C = erlang:get_stacktrace(), + ?line try erlang:raise(error, function_clause, C0) + catch error:function_clause -> ok + end, + ?line C = erlang:get_stacktrace(), + ok. + +odd_even(N, R) when is_integer(N), N > 1 -> + odd_even(N-1, + [if (N rem 2) == 0 -> + {?MODULE,even,1,[{file,?MODULE_STRING++".erl"}, + {line,42}]}; + true -> + {?MODULE,odd,1,[{file,?MODULE_STRING++".erl"}, + {line,45}]} + end|R]); +odd_even(1, R) -> + [{?MODULE,odd,[1],[{file,?MODULE_STRING++".erl"}, + {line,44}]}|R]. + +foo({value,Value}) -> Value; +foo({'div',{A,B}}) -> + my_div(A, B); +foo({'add',{A,B}}) -> + my_add(A, B); +foo({'abs',X}) -> + my_abs(X); +foo({error,Error}) -> + erlang:error(Error); +foo({throw,Throw}) -> + erlang:throw(Throw); +foo({exit,Exit}) -> + erlang:exit(Exit); +foo({raise,{Class,Reason,Stacktrace}}) -> + erlang:raise(Class, Reason, Stacktrace). +%%foo(function_clause) -> % must not be defined! + +my_div(A, B) -> + A div B. + +my_add(A, B) -> + A + B. + +my_abs(X) -> abs(X). + +gunilla(Config) when is_list(Config) -> + ?line {throw,kalle} = gunilla_1(), + ?line [] = erlang:get_stacktrace(), + ok. + +gunilla_1() -> + try try arne() + after + pelle + end + catch + C:R -> + {C,R} + end. + +arne() -> + %% Empty stack trace used to cause change the error class to 'error'. + erlang:raise(throw, kalle, []). + +per(Config) when is_list(Config) -> + try + t1(0,pad,0), + t2(0,pad,0) + catch + error:badarith -> + ok + end. + +t1(_,X,_) -> + (1 bsl X) + 1. + +t2(_,X,_) -> + (X bsl 1) + 1. + +id(I) -> I. diff --git a/lib/debugger/test/guard_SUITE.erl b/lib/debugger/test/guard_SUITE.erl index 611dcb4dff..bf5fa82749 100644 --- a/lib/debugger/test/guard_SUITE.erl +++ b/lib/debugger/test/guard_SUITE.erl @@ -35,7 +35,8 @@ t_is_boolean/1,is_function_2/1, tricky/1,rel_ops/1, basic_andalso_orelse/1,traverse_dcd/1, - check_qlc_hrl/1]). + check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, + bad_constants/1]). -include_lib("test_server/include/test_server.hrl"). @@ -65,7 +66,8 @@ cases() -> xor_guard, more_xor_guards, build_in_guard, old_guard_tests, gbif, t_is_boolean, is_function_2, tricky, rel_ops, basic_andalso_orelse, traverse_dcd, - check_qlc_hrl]. + check_qlc_hrl, andalso_semi, t_tuple_size, binary_part, + bad_constants]. init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), @@ -294,9 +296,7 @@ try_gbif(Id, X, Y) -> try_fail_gbif(Id, X, Y) -> case catch guard_bif(Id, X, Y) of - {'EXIT', {function_clause,{?MODULE,guard_bif,[Id,X,Y]}}} -> %Jam - io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]); - {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} -> %Beam + {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y],_}|_]}} -> io:format("guard_bif(~p, ~p, ~p) -- ok", [Id,X,Y]); Other -> ?line ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", @@ -367,9 +367,8 @@ type_tests(Test, [Type|T], Allowed) -> end; false -> case catch type_test(Test, Value) of - {'EXIT', {function_clause, {?MODULE, type_test, [Test, Value]}}} -> - ok; - {'EXIT', {function_clause,[{?MODULE,type_test,[Test,Value]}|_]}} -> + {'EXIT',{function_clause, + [{?MODULE,type_test,[Test,Value],_}|_]}} -> ok; {'EXIT',Other} -> ?line test_server:fail({unexpected_error_reason,Other}); @@ -1477,7 +1476,207 @@ cqlc(M, F, As, St) -> St end. +%% OTP-7679: Thanks to Hunter Morris. +andalso_semi(Config) when is_list(Config) -> + ?line ok = andalso_semi_foo(0), + ?line ok = andalso_semi_foo(1), + ?line fc(catch andalso_semi_foo(2)), + + ?line ok = andalso_semi_bar([a,b,c]), + ?line ok = andalso_semi_bar(1), + ?line fc(catch andalso_semi_bar([a,b])), + ok. + +andalso_semi_foo(Bar) when is_integer(Bar) andalso Bar =:= 0; Bar =:= 1 -> + ok. + +andalso_semi_bar(Bar) when is_list(Bar) andalso length(Bar) =:= 3; Bar =:= 1 -> + ok. + + +t_tuple_size(Config) when is_list(Config) -> + ?line 10 = do_tuple_size({1,2,3,4}), + ?line fc(catch do_tuple_size({1,2,3})), + ?line fc(catch do_tuple_size(42)), + ?line error = ludicrous_tuple_size({a,b,c}), + ?line error = ludicrous_tuple_size([a,b,c]), + + ok. + +do_tuple_size(T) when tuple_size(T) =:= 4 -> + {A,B,C,D} = T, + A+B+C+D. + +ludicrous_tuple_size(T) + when tuple_size(T) =:= 16#7777777777777777777777777777777777 -> ok; +ludicrous_tuple_size(T) + when tuple_size(T) =:= 16#10000000000000000 -> ok; +ludicrous_tuple_size(T) + when tuple_size(T) =:= (1 bsl 64) - 1 -> ok; +ludicrous_tuple_size(T) + when tuple_size(T) =:= 16#FFFFFFFFFFFFFFFF -> ok; +ludicrous_tuple_size(_) -> error. + +%% +%% The binary_part/2,3 guard BIFs +%% +-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))). +mask_error({'EXIT',{Err,_}}) -> + Err; +mask_error(Else) -> + Else. + +binary_part(doc) -> + ["Tests the binary_part/2,3 guard (GC) bif's"]; +binary_part(Config) when is_list(Config) -> + %% This is more or less a copy of what the guard_SUITE in emulator + %% does to cover the guard bif's + ?line 1 = bptest(<<1,2,3>>), + ?line 2 = bptest(<<2,1,3>>), + ?line error = bptest(<<1>>), + ?line error = bptest(<<>>), + ?line error = bptest(apa), + ?line 3 = bptest(<<2,3,3>>), + % With one variable (pos) + ?line 1 = bptest(<<1,2,3>>,1), + ?line 2 = bptest(<<2,1,3>>,1), + ?line error = bptest(<<1>>,1), + ?line error = bptest(<<>>,1), + ?line error = bptest(apa,1), + ?line 3 = bptest(<<2,3,3>>,1), + % With one variable (length) + ?line 1 = bptesty(<<1,2,3>>,1), + ?line 2 = bptesty(<<2,1,3>>,1), + ?line error = bptesty(<<1>>,1), + ?line error = bptesty(<<>>,1), + ?line error = bptesty(apa,1), + ?line 3 = bptesty(<<2,3,3>>,2), + % With one variable (whole tuple) + ?line 1 = bptestx(<<1,2,3>>,{1,1}), + ?line 2 = bptestx(<<2,1,3>>,{1,1}), + ?line error = bptestx(<<1>>,{1,1}), + ?line error = bptestx(<<>>,{1,1}), + ?line error = bptestx(apa,{1,1}), + ?line 3 = bptestx(<<2,3,3>>,{1,2}), + % With two variables + ?line 1 = bptest(<<1,2,3>>,1,1), + ?line 2 = bptest(<<2,1,3>>,1,1), + ?line error = bptest(<<1>>,1,1), + ?line error = bptest(<<>>,1,1), + ?line error = bptest(apa,1,1), + ?line 3 = bptest(<<2,3,3>>,1,2), + % Direct (autoimported) call, these will be evaluated by the compiler... + ?line <<2>> = binary_part(<<1,2,3>>,1,1), + ?line <<1>> = binary_part(<<2,1,3>>,1,1), + % Compiler warnings due to constant evaluation expected (3) + ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)), + ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)), + ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)), + ?line <<3,3>> = binary_part(<<2,3,3>>,1,2), + % Direct call through apply + ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]), + ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]), + % Compiler warnings due to constant evaluation expected (3) + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])), + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])), + ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])), + ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]), + % Constant propagation + ?line Bin = <<1,2,3>>, + ?line ok = if + binary_part(Bin,1,1) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, + ?line ok = if + binary_part(Bin,{1,1}) =:= <<2>> -> + ok; + %% Compiler warning, clause cannot match (expected) + true -> + error + end, + ok. + + +bptest(B) when length(B) =:= 1337 -> + 1; +bptest(B) when binary_part(B,{1,1}) =:= <<2>> -> + 1; +bptest(B) when erlang:binary_part(B,1,1) =:= <<1>> -> + 2; +bptest(B) when erlang:binary_part(B,{1,2}) =:= <<3,3>> -> + 3; +bptest(_) -> + error. + +bptest(B,A) when length(B) =:= A -> + 1; +bptest(B,A) when binary_part(B,{A,1}) =:= <<2>> -> + 1; +bptest(B,A) when erlang:binary_part(B,A,1) =:= <<1>> -> + 2; +bptest(B,A) when erlang:binary_part(B,{A,2}) =:= <<3,3>> -> + 3; +bptest(_,_) -> + error. + +bptestx(B,A) when length(B) =:= A -> + 1; +bptestx(B,A) when binary_part(B,A) =:= <<2>> -> + 1; +bptestx(B,A) when erlang:binary_part(B,A) =:= <<1>> -> + 2; +bptestx(B,A) when erlang:binary_part(B,A) =:= <<3,3>> -> + 3; +bptestx(_,_) -> + error. + +bptesty(B,A) when length(B) =:= A -> + 1; +bptesty(B,A) when binary_part(B,{1,A}) =:= <<2>> -> + 1; +bptesty(B,A) when erlang:binary_part(B,1,A) =:= <<1>> -> + 2; +bptesty(B,A) when erlang:binary_part(B,{1,A}) =:= <<3,3>> -> + 3; +bptesty(_,_) -> + error. + +bptest(B,A,_C) when length(B) =:= A -> + 1; +bptest(B,A,C) when binary_part(B,{A,C}) =:= <<2>> -> + 1; +bptest(B,A,C) when erlang:binary_part(B,A,C) =:= <<1>> -> + 2; +bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> -> + 3; +bptest(_,_,_) -> + error. + +-define(FAILING(C), + if + C -> ?t:fail(should_fail); + true -> ok + end, + if + true, C -> ?t:fail(should_fail); + true -> ok + end). + +bad_constants(Config) when is_list(Config) -> + ?line ?FAILING(false), + ?line ?FAILING([]), + ?line ?FAILING([a]), + ?line ?FAILING([Config]), + ?line ?FAILING({a,b}), + ?line ?FAILING({a,Config}), + ?line ?FAILING(<<1>>), + ?line ?FAILING(42), + ?line ?FAILING(3.14), + ok. %% Call this function to turn off constant propagation. id(I) -> I. @@ -1490,3 +1689,5 @@ check(F, Result) -> io:format(" Got: ~p\n", [Other]), test_server:fail() end. + +fc({'EXIT',{function_clause,_}}) -> ok. diff --git a/lib/debugger/test/int_eval_SUITE.erl b/lib/debugger/test/int_eval_SUITE.erl index f36ed213d1..4ffcf7888e 100644 --- a/lib/debugger/test/int_eval_SUITE.erl +++ b/lib/debugger/test/int_eval_SUITE.erl @@ -28,7 +28,7 @@ bifs_outside_erlang/1, spawning/1, applying/1, catch_and_throw/1, external_call/1, test_module_info/1, apply_interpreted_fun/1, apply_uninterpreted_fun/1, - interpreted_exit/1, otp_8310/1]). + interpreted_exit/1, otp_8310/1, stacktrace/1]). %% Helpers. -export([applier/3]). @@ -44,7 +44,7 @@ all() -> [bifs_outside_erlang, spawning, applying, catch_and_throw, external_call, test_module_info, apply_interpreted_fun, apply_uninterpreted_fun, - interpreted_exit, otp_8310]. + interpreted_exit, otp_8310, stacktrace]. groups() -> []. @@ -191,23 +191,23 @@ apply_interpreted_fun(Config) when is_list(Config) -> ?line {ok,ATerm} = spawn_eval(fun() -> F2() end), %% Called from uninterpreted code, badarity - ?line {'EXIT',{{badarity,{F1,[snape]}},[{?MODULE,_,_}|_]}} = + ?line {'EXIT',{{badarity,{F1,[snape]}},[{?MODULE,_,_,_}|_]}} = spawn_eval(fun() -> F1(snape) end), %% Called from uninterpreted code, error in fun ?line F3 = spawn_eval(fun() -> ?IM:give_me_a_bad_fun() end), - ?line {'EXIT',{snape,[{?IM,_FunName,_}|_]}} = + ?line {'EXIT',{snape,[{?IM,_FunName,_,_}|_]}} = spawn_eval(fun() -> F3(snape) end), %% Called from within interpreted code ?line perfectly_alright = spawn_eval(fun() -> ?IM:do_apply(F1) end), %% Called from within interpreted code, badarity - ?line {'EXIT',{{badarity,{F1,[snape]}},[{?IM,do_apply,_}|_]}} = + ?line {'EXIT',{{badarity,{F1,[snape]}},[{?IM,do_apply,_,_}|_]}} = spawn_eval(fun() -> ?IM:do_apply(F1, snape) end), %% Called from within interpreted code, error in fun - ?line {'EXIT',{snape,[{?IM,_FunName,_}|_]}} = + ?line {'EXIT',{snape,[{?IM,_FunName,_,_}|_]}} = spawn_eval(fun() -> ?IM:do_apply(F3, snape) end), %% Try some more complex funs. @@ -239,11 +239,11 @@ apply_uninterpreted_fun(Config) when is_list(Config) -> spawn_eval(fun() -> ?IM:do_apply(F1, any_arg) end), %% Badarity (evaluated in dbg_debugged, which calls erlang:apply/2) - ?line {'EXIT',{{badarity,{F1,[]}},[{erlang,apply,_}|_]}} = + ?line {'EXIT',{{badarity,{F1,[]}},[{erlang,apply,_,_}|_]}} = spawn_eval(fun() -> ?IM:do_apply(F1) end), %% Error in fun - ?line {'EXIT',{snape,[{?MODULE,_FunName,_}|_]}} = + ?line {'EXIT',{snape,[{?MODULE,_FunName,_,_}|_]}} = spawn_eval(fun() -> ?IM:do_apply(F1, snape) end), ok. @@ -277,6 +277,37 @@ applier(M, F, A) -> io:format("~p:~p(~p) => ~p\n", [M,F,A,Res]), Res. +stacktrace(Config) when is_list(Config) -> + ?line {done,Stk} = do_eval(Config, stacktrace), + ?line 13 = length(Stk), + ?line OldStackTraceFlag = int:stack_trace(), + ?line int:stack_trace(no_tail), + try + ?line Res = spawn_eval(fun() -> stacktrace:stacktrace() end), + ?line io:format("\nInterpreted (no_tail):\n~p", [Res]), + ?line {done,Stk} = Res + after + ?line int:stack_trace(OldStackTraceFlag) + end, + ok. + + +do_eval(Config, Mod) -> + ?line DataDir = ?config(data_dir, Config), + ?line ok = file:set_cwd(DataDir), + + ?line {ok,Mod} = compile:file(Mod, [report,debug_info]), + ?line {module,Mod} = code:load_file(Mod), + ?line CompiledRes = Mod:Mod(), + ?line ok = io:format("Compiled:\n~p", [CompiledRes]), + io:nl(), + + ?line {module,Mod} = int:i(Mod), + ?line IntRes = Mod:Mod(), + ?line ok = io:format("Interpreted:\n~p", [IntRes]), + + ?line CompiledRes = IntRes. + %% %% Evaluate in another process, to prevent the test_case process to become %% interpreted. diff --git a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl index 997ee6e17d..90f83e80e8 100644 --- a/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl +++ b/lib/debugger/test/int_eval_SUITE_data/my_int_eval_module.erl @@ -117,7 +117,7 @@ more_nocatch(Fun) -> %% External calls. external_call_test(Data) -> - {'EXIT',{undef,[{?MODULE,not_exported,[42,Data]}|_]}} = + {'EXIT',{undef,[{?MODULE,not_exported,[42,Data],_}|_]}} = (catch ?MODULE:not_exported(42, Data)), {yes,Data} = i_am_exported(Data), {yes,Data} = ?MODULE:i_am_exported(Data), @@ -127,7 +127,7 @@ external_call_test(Data) -> {ok,Data,[a,b]} = not_exported(Data, [a,b]), {yes,Data} = i_am_exported(Data), {ok,Data,[a,b]} = not_exported(Data, [a,b]), - {'EXIT',{undef,[{?MODULE,not_exported,[7,Data]}|_]}} = + {'EXIT',{undef,[{?MODULE,not_exported,[7,Data],_}|_]}} = (catch ?MODULE:not_exported(7, Data)), {yes,Data} = ?MODULE:i_am_exported(Data), ok. diff --git a/lib/debugger/test/int_eval_SUITE_data/stacktrace.erl b/lib/debugger/test/int_eval_SUITE_data/stacktrace.erl new file mode 100644 index 0000000000..3380178fdc --- /dev/null +++ b/lib/debugger/test/int_eval_SUITE_data/stacktrace.erl @@ -0,0 +1,130 @@ +-module(stacktrace). +-export([?MODULE/0]). + +?MODULE() -> + OldDepth = erlang:system_flag(backtrace_depth, 32), + done = (catch do_try()), + Stk = trim(erlang:get_stacktrace()), + erlang:system_flag(backtrace_depth, OldDepth), + {done,Stk}. + +trim([{int_eval_SUITE,_,_,_}|_]) -> + []; +trim([H|T]) -> + [H|trim(T)]; +trim([]) -> []. + +do_try() -> + try + 0 = id(42) + catch + error:{badmatch,42} -> + do_try2() %Tail-recursive + end. + +do_try2() -> + try + 0 = id(42) + catch + error:{badmatch,42} -> + do_try3() %Not tail-recursive + end, + ?LINE. + +do_try3() -> + try id(42) of + 42 -> do_try4() %Tail-recursive + catch + error:ignore -> %Should never catch + ?LINE + end. + +do_try4() -> + try + do_recv() %Not tail-recursive + catch + error:ignore -> %Should never catch + ?LINE + end. + +do_recv() -> + self() ! x, + receive + x -> do_recv2() %Not tail-recursive + end, + ?LINE. + +do_recv2() -> + self() ! y, + receive + y -> do_recv3() %Tail-recursive + end. + +do_recv3() -> + receive + after 0 -> do_recv4() %Tail-recursive + end. + +do_recv4() -> + receive + after 0 -> do_if(true) %Not tail-recursive + end, + ?LINE. + +do_if(Bool) -> + if + Bool -> do_if2(Bool) %Tail-recursive + end. + +do_if2(Bool) -> + if + Bool -> do_case(Bool) %Not tail-recursive + end, + ?LINE. + + +do_case(Bool) -> + case Bool of + true -> do_case2(Bool) %Tail-recursive + end. + +do_case2(Bool) -> + case Bool of + true -> do_fun(Bool) %Not tail-recursive + end, + ?LINE. + +do_fun(Bool) -> + F = fun(true) -> + do_fun2(Bool) %Tail-recursive + end, + F(Bool). %Tail-recursive + +do_fun2(Bool) -> + F = fun(true) -> + cons(Bool) %Tail-recursive + end, + F(Bool), %Not tail-recursive + ?LINE. + +cons(Bool) -> + [Bool|tuple()]. + +tuple() -> + {ok,op()}. + +op() -> + 1 + lc(). + +lc() -> + [done() || true]. + +done() -> + tail(100), + throw(done). + +tail(0) -> ok; +tail(N) -> tail(N-1). + +id(I) -> + I. diff --git a/lib/debugger/test/lc_SUITE.erl b/lib/debugger/test/lc_SUITE.erl index 92a03ef58e..2f05eb7fca 100644 --- a/lib/debugger/test/lc_SUITE.erl +++ b/lib/debugger/test/lc_SUITE.erl @@ -17,21 +17,22 @@ %% %CopyrightEnd% %% -%% -module(lc_SUITE). --author('[email protected]'). +%% Copied from lc_SUITE in the compiler application. + -export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, init_per_suite/1,end_per_suite/1, - basic/1]). + basic/1,deeply_nested/1,no_generator/1, + empty_generator/1]). -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - cases(). + [basic, deeply_nested, no_generator, empty_generator]. groups() -> []. @@ -42,10 +43,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - -cases() -> - [basic]. - init_per_testcase(_Case, Config) -> test_lib:interpret(?MODULE), Dog = test_server:timetrap(?t:minutes(1)), @@ -64,7 +61,7 @@ init_per_suite(Config) when is_list(Config) -> end_per_suite(Config) when is_list(Config) -> ok. -basic(Config) when list(Config) -> +basic(Config) when is_list(Config) -> ?line L0 = lists:seq(1, 10), ?line L1 = my_map(fun(X) -> {x,X} end, L0), ?line L1 = [{x,X} || X <- L0], @@ -73,16 +70,116 @@ basic(Config) when list(Config) -> ?line [4,5,6] = [X || X <- L0, X > 3, X < 7], ?line [] = [X || X <- L0, X > 32, X < 7], ?line [1,3,5,7,9] = [X || X <- L0, odd(X)], + ?line [2,4,6,8,10] = [X || X <- L0, not odd(X)], + ?line [1,3,5,9] = [X || X <- L0, odd(X), X =/= 7], + ?line [2,4,8,10] = [X || X <- L0, not odd(X), X =/= 6], + + %% Append is specially handled. + ?line [1,3,5,9,2,4,8,10] = [X || X <- L0, odd(X), X =/= 7] ++ + [X || X <- L0, not odd(X), X =/= 6], + + %% Guards BIFs are evaluated in guard context. Weird, but true. + ?line [{a,b,true},{x,y,true,true}] = [X || X <- tuple_list(), element(3, X)], + + %% Filter expressions with andalso/orelse. + ?line "abc123" = alphanum("?abc123.;"), %% Error cases. - ?line [] = [X || X <- L1, X+1 < 2], ?line [] = [{xx,X} || X <- L0, element(2, X) == no_no_no], - ?line {'EXIT',_} = (catch [X || X <- L1, odd(X)]), + ?line {'EXIT',_} = (catch [X || X <- L1, list_to_atom(X) == dum]), + ?line [] = [X || X <- L1, X+1 < 2], + ?line {'EXIT',_} = (catch [X || X <- L1, odd(X)]), + %% A bad generator has a different exception compared to BEAM. + ?line {'EXIT',{{bad_generator,x},_}} = (catch [E || E <- id(x)]), ok. +tuple_list() -> + [{a,b,true},[a,b,c],glurf,{a,b,false,xx},{a,b},{x,y,true,true},{a,b,d,ddd}]. + my_map(F, L) -> [F(X) || X <- L]. odd(X) -> X rem 2 == 1. + +alphanum(Str) -> + [C || C <- Str, ((C >= $0) andalso (C =< $9)) + orelse ((C >= $a) andalso (C =< $z)) + orelse ((C >= $A) andalso (C =< $Z))]. + +deeply_nested(Config) when is_list(Config) -> + [[99,98,97,96,42,17,1764,12,11,10,9,8,7,6,5,4,3,7,2,1]] = deeply_nested_1(), + ok. + +deeply_nested_1() -> + %% This used to compile really, really SLOW before R11B-1... + [[X1,X2,X3,X4,X5,X6,X7(),X8,X9,X10,X11,X12,X13,X14,X15,X16,X17,X18(),X19,X20] || + X1 <- [99],X2 <- [98],X3 <- [97],X4 <- [96],X5 <- [42],X6 <- [17], + X7 <- [fun() -> X5*X5 end],X8 <- [12],X9 <- [11],X10 <- [10], + X11 <- [9],X12 <- [8],X13 <- [7],X14 <- [6],X15 <- [5], + X16 <- [4],X17 <- [3],X18 <- [fun() -> X16+X17 end],X19 <- [2],X20 <- [1]]. + +no_generator(Config) when is_list(Config) -> + ?line Seq = lists:seq(-10, 17), + ?line [no_gen_verify(no_gen(A, B), A, B) || A <- Seq, B <- Seq], + + %% Literal expression, for coverage. + ?line [a] = [a || true], + ?line [a,b,c] = [a || true] ++ [b,c], + ok. + +no_gen(A, B) -> + [{A,B} || A+B =:= 0] ++ + [{A,B} || A*B =:= 0] ++ + [{A,B} || A rem B =:= 3] ++ + [{A,B} || A =:= B] ++ + [{one_more,A,B} || no_gen_one_more(A, B)] ++ + [A || A =:= 1] ++ + [A || A =:= 2] ++ + [A || A =:= 3] ++ + [A || A =:= 4] ++ + [A || A =:= 5] ++ + [A || A =:= 6] ++ + [A || A =:= 7] ++ + [A || A =:= 8] ++ + [A || A =:= 9] ++ + [B || B =:= 1] ++ + [B || B =:= 2] ++ + [B || B =:= 3] ++ + [B || B =:= 4] ++ + [B || B =:= 5] ++ + [B || B =:= 6] ++ + [B || B =:= 7] ++ + [B || B =:= 8] ++ + [B || B =:= 9]. + +no_gen_verify(Res, A, B) -> + Pair = {A,B}, + ShouldBe = no_gen_eval(fun() -> A+B =:= 0 end, Pair) ++ + no_gen_eval(fun() -> A*B =:= 0 end, Pair) ++ + no_gen_eval(fun() -> B =/= 0 andalso A rem B =:= 3 end, Pair) ++ + no_gen_eval(fun() -> A =:= B end, Pair) ++ + no_gen_eval(fun() -> A + 1 =:= B end, {one_more,A,B}) ++ + no_gen_eval(fun() -> 1 =< A andalso A =< 9 end, A) ++ + no_gen_eval(fun() -> 1 =< B andalso B =< 9 end, B), + case Res of + ShouldBe -> ok; + _ -> + io:format("A = ~p; B = ~p; Expected = ~p, actual = ~p", [A,B,ShouldBe,Res]), + ?t:fail() + end. + +no_gen_eval(Fun, Res) -> + case Fun() of + true -> [Res]; + false -> [] + end. + +no_gen_one_more(A, B) -> A + 1 =:= B. + +empty_generator(Config) when is_list(Config) -> + ?line [] = [X || {X} <- [], (false or (X/0 > 3))], + ok. + +id(I) -> I. diff --git a/lib/debugger/test/line_number_SUITE.erl b/lib/debugger/test/line_number_SUITE.erl new file mode 100644 index 0000000000..d1f56d3493 --- /dev/null +++ b/lib/debugger/test/line_number_SUITE.erl @@ -0,0 +1,220 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(line_number_SUITE). + +-export([all/0, suite/0,groups/0,init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2, + init_per_suite/1,end_per_suite/1, + line_numbers/1]). +-export([crash/1]). + +-include_lib("test_server/include/test_server.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + cases(). + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +cases() -> + [line_numbers]. + +init_per_testcase(_Case, Config) -> + test_lib:interpret(?MODULE), + Dog = test_server:timetrap(?t:minutes(1)), + [{watchdog,Dog}|Config]. + +end_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +init_per_suite(Config) when is_list(Config) -> + ?line test_lib:interpret(?MODULE), + ?line true = lists:member(?MODULE, int:interpreted()), + Config. + +end_per_suite(Config) when is_list(Config) -> + ok. + + + + + +%% +%% === Make sure that this is always line 70 === +%% +line1(Tag, X) -> %Line 72 + case Tag of %Line 73 + a -> + Y = X + 1, %Line 75 + Res = id({ok,Y}), %Line 76 + ?MODULE:crash({ok,42} = Res); %Line 77 + b -> + x = id(x), %Line 79 + ok %Line 80 + end. %Line 81 + +crash(_) -> %Line 83 + erlang:error(crash). %Line 84 + +close_calls(Where) -> %Line 86 + put(where_to_crash, Where), %Line 87 + try + call1(), %Line 89 + call2(), %Line 90 + call3(), %Line 91 + no_crash %Line 92 + catch error:crash -> + erlang:get_stacktrace() %Line 94 + end. %Line 95 + +call1() -> %Line 97 + maybe_crash(call1), %Line 98 + ok. %Line 99 + +call2() -> %Line 101 + maybe_crash(call2), %Line 102 + ok. %Line 103 + +call3() -> %Line 105 + maybe_crash(call3), %Line 106 + ok. %Line 107 + +maybe_crash(Name) -> %Line 109 + case get(where_to_crash) of %Line 110 + Name -> + erlang:error(crash); %Line 112 + _ -> + ok %Line 114 + end. %Line 115 + +build_binary1(Size) -> %Line 117 + id(42), %Line 118 + <<0:Size>>. %Line 119 + +build_binary2(Size, Bin) -> %Line 121 + id(0), %Line 122 + <<7:Size,Bin/binary>>. %Line 123 + +do_call_abs(x, Arg) -> %Line 125 + abs(Arg). %Line 126 + +do_call_unsafe_bif(x, Arg) -> %Line 128 + link(Arg). %Line 129 + + +line_numbers(Config) when is_list(Config) -> + File = ?MODULE_STRING ++ ".erl", + {'EXIT',{{case_clause,bad_tag}, + [{?MODULE,line1,2, + [{file,File},{line,73}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(bad_tag, 0)), + {'EXIT',{badarith, + [{?MODULE,line1,2, + [{file,File},{line,75}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, not_an_integer)), + {'EXIT',{{badmatch,{ok,1}}, + [{?MODULE,line1,2, + [{file,File},{line,77}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, 0)), + {'EXIT',{crash, + [{?MODULE,crash,1, + [{file,File},{line,84}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch line1(a, 41)), + + [{?MODULE,maybe_crash,1,[{file,File},{line,112}]}, + {?MODULE,call1,0,[{file,File},{line,98}]}, + {?MODULE,close_calls,1,[{file,File},{line,89}]}, + {?MODULE,line_numbers,1,[{file,File},{line,_}]}|_] = + close_calls(call1), + [{?MODULE,maybe_crash,1,[{file,File},{line,112}]}, + {?MODULE,call2,0,[{file,File},{line,102}]}, + {?MODULE,close_calls,1,[{file,File},{line,90}]}, + {?MODULE,line_numbers,1,[{file,File},{line,_}]}|_] = + close_calls(call2), + [{?MODULE,maybe_crash,1,[{file,File},{line,112}]}, + {?MODULE,call3,0,[{file,File},{line,106}]}, + {?MODULE,close_calls,1,[{file,File},{line,91}]}, + {?MODULE,line_numbers,1,[{file,File},{line,_}]}|_] = + close_calls(call3), + no_crash = close_calls(other), + + <<0,0>> = build_binary1(16), + {'EXIT',{badarg, + [{?MODULE,build_binary1,1, + [{file,File},{line,119}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary1(bad_size)), + + <<7,1,2,3>> = build_binary2(8, <<1,2,3>>), + {'EXIT',{badarg, + [{?MODULE,build_binary2,2, + [{file,File},{line,123}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary2(bad_size, <<>>)), + {'EXIT',{badarg, + [%% Beam has an extra here: + %% {erlang,bit_size,[bad_binary],[]} + %% Since this is an artifact of the implementation, + %% we don't attempt to mimic it in the debugger. + {?MODULE,build_binary2,2, + [{file,File},{line,123}]}, + {?MODULE,line_numbers,1, + [{file,ModFile},{line,_}]}|_]}} = + (catch build_binary2(8, bad_binary)), + + {'EXIT',{function_clause, + [{?MODULE,do_call_abs,[y,y], + [{file,File},{line,125}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_abs(y, y)), + {'EXIT',{badarg, + [{erlang,abs,[[]],[]}, + {?MODULE,do_call_abs,2, + [{file,File},{line,126}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_abs(x, [])), + + {'EXIT',{badarg, + [{erlang,link,[[]],[]}, + {?MODULE,do_call_unsafe_bif,2, + [{file,File},{line,129}]}, + {?MODULE,line_numbers,1,_}|_]}} = + (catch do_call_unsafe_bif(x, [])), + + ok. + +id(I) -> + I. diff --git a/lib/debugger/test/test_lib.erl b/lib/debugger/test/test_lib.erl index 541375e64a..5e4ac7f164 100644 --- a/lib/debugger/test/test_lib.erl +++ b/lib/debugger/test/test_lib.erl @@ -22,7 +22,7 @@ -export([interpret/1]). -interpret(Mod) when atom(Mod) -> +interpret(Mod) when is_atom(Mod) -> case lists:member(Mod, int:interpreted()) of true -> ok; false -> {module,Mod} = i:ii(Mod) diff --git a/lib/debugger/test/trycatch_SUITE.erl b/lib/debugger/test/trycatch_SUITE.erl index a87c5db138..470d46d915 100644 --- a/lib/debugger/test/trycatch_SUITE.erl +++ b/lib/debugger/test/trycatch_SUITE.erl @@ -318,17 +318,18 @@ eclectic(Conf) when is_list(Conf) -> V = {make_ref(),3.1415926535,[[]|{}]}, ?line {{value,{value,V},V},V} = eclectic_1({foo,{value,{value,V}}}, undefined, {value,V}), - ?line {{'EXIT',{V,[{?MODULE,foo,_}|_]}},V} = + ?line {{'EXIT',{V,[{?MODULE,foo,_,_}|_]}},V} = eclectic_1({catch_foo,{error,V}}, undefined, {value,V}), ?line {{error,{exit,V},{'EXIT',V}},V} = eclectic_1({foo,{error,{exit,V}}}, error, {value,V}), - ?line {{value,{value,V},V},{'EXIT',{badarith,[{?MODULE,my_add,_}|_]}}} = + ?line {{value,{value,V},V},{'EXIT',{badarith,[{?MODULE,my_add,_,_}|_]}}} = eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}), ?line {{'EXIT',V},V} = eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}), - ?line {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,_}|_]}}}, {'EXIT',V}} = + ?line {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,_,_}|_]}}}, + {'EXIT',V}} = eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}), - ?line {{{error,V},{'EXIT',{V,[{?MODULE,foo,_}|_]}}},{'EXIT',V}} = + ?line {{{error,V},{'EXIT',{V,[{?MODULE,foo,_,_}|_]}}},{'EXIT',V}} = eclectic_1({catch_foo,{throw,{error,V}}}, undefined, {exit,V}), %% ?line {{value,{value,{value,V},V}},V} = @@ -337,15 +338,15 @@ eclectic(Conf) when is_list(Conf) -> eclectic_2({throw,{value,V}}, throw, {value,V}), ?line {{caught,{'EXIT',V}},undefined} = eclectic_2({value,{value,V}}, undefined, {exit,V}), - ?line {{caught,{'EXIT',{V,[{?MODULE,foo,_}|_]}}},undefined} = + ?line {{caught,{'EXIT',{V,[{?MODULE,foo,_,_}|_]}}},undefined} = eclectic_2({error,{value,V}}, throw, {error,V}), - ?line {{caught,{'EXIT',{badarg,[{erlang,abs,[V]}|_]}}},V} = + ?line {{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} = eclectic_2({value,{'abs',V}}, undefined, {value,V}), - ?line {{caught,{'EXIT',{badarith,[{?MODULE,my_add,_}|_]}}},V} = + ?line {{caught,{'EXIT',{badarith,[{?MODULE,my_add,_,_}|_]}}},V} = eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}), ?line {{caught,{'EXIT',V}},undefined} = eclectic_2({value,{error,V}}, undefined, {exit,V}), - ?line {{caught,{'EXIT',{V,[{?MODULE,foo,_}|_]}}},undefined} = + ?line {{caught,{'EXIT',{V,[{?MODULE,foo,_,_}|_]}}},undefined} = eclectic_2({throw,{'div',{1,0}}}, throw, {error,V}), ok. diff --git a/lib/diameter/src/app/Makefile b/lib/diameter/src/app/Makefile index 6de220d282..31344fa80b 100644 --- a/lib/diameter/src/app/Makefile +++ b/lib/diameter/src/app/Makefile @@ -52,6 +52,14 @@ INCDIR = ../../include include modules.mk +diameter_gen_base_accounting.erl: \ + $(EBIN)/diameter_gen_base_rfc3588.beam +diameter_gen_relay.erl: \ + $(EBIN)/diameter_gen_base_rfc3588.beam + +SPEC_MODULES = \ + $(SPEC_FILES:%.dia=%) + SPEC_ERL_FILES = \ $(SPEC_FILES:%.dia=%.erl) @@ -60,7 +68,7 @@ SPEC_HRL_FILES = \ APP_MODULES = \ $(MODULES) \ - $(SPEC_FILES:%.dia=%) + $(SPEC_MODULES) TARGET_FILES = \ $(APP_MODULES:%=$(EBIN)/%.$(EMULATOR)) \ @@ -150,6 +158,7 @@ app: $(APP_TARGET) $(APPUP_TARGET) diameter_gen_%.erl diameter_gen_%.hrl: diameter_gen_%.dia ../../bin/diameterc -i $(EBIN) -o $(@D) $< +$(SPEC_MODULES:%=$(EBIN)/%.$(EMULATOR)): $(EBIN)/diameter_exprecs.$(EMULATOR) # ---------------------------------------------------- # Release Target diff --git a/lib/docbuilder/src/docb_main.erl b/lib/docbuilder/src/docb_main.erl index 4f5f035a65..c20cfc8e67 100644 --- a/lib/docbuilder/src/docb_main.erl +++ b/lib/docbuilder/src/docb_main.erl @@ -436,11 +436,11 @@ transform(From, To, Opts, File, Tree) -> case catch Filter:transform(File, Tree, Opts) of %% R5C - {'EXIT', {undef, [{Filter, transform, [File, Tree, Opts]}|_]}}-> + {'EXIT', {undef, [{Filter, transform, [File, Tree, Opts],_}|_]}}-> %% No transformation defined finish_transform(Tree, File, Opts, Filter); - {'EXIT', {undef, {Filter, transform, [File, Tree, Opts]}}} -> + {'EXIT', {undef, {Filter, transform, [File, Tree, Opts],_}}} -> %% No transformation defined finish_transform(Tree, File, Opts, Filter); @@ -507,16 +507,16 @@ pp({Tag, Optional, Args}, TagPath, Level, Filter, Opts) -> Rule_3_result = case catch Filter:rule(TagPath1, {Level,Optional1,Args},Opts) of %% R5C - {'EXIT', {undef, [{_, rule, _}|_]}} -> % No rule/3 defined + {'EXIT', {undef, [{_, rule, _, _}|_]}} -> % No rule/3 defined failed; - {'EXIT', {undef, {_, rule, _}}} -> % No rule/3 defined + {'EXIT', {undef, {_, rule, _, _}}} -> % No rule/3 defined failed; %% R5C - {'EXIT', {function_clause, [{_, rule, _}|_]}} -> % No MATCHING rule/3 + {'EXIT', {function_clause, [{_, rule, _, _}|_]}} -> % No MATCHING rule/3 failed; - {'EXIT', {function_clause, {_, rule, _}}} -> % No MATCHING rule/3 + {'EXIT', {function_clause, {_, rule, _, _}}} -> % No MATCHING rule/3 failed; {'EXIT', What} -> diff --git a/lib/erl_interface/src/Makefile.in b/lib/erl_interface/src/Makefile.in index 8ff142a366..0d841cfa48 100644 --- a/lib/erl_interface/src/Makefile.in +++ b/lib/erl_interface/src/Makefile.in @@ -143,7 +143,6 @@ BINDIR = $(ERL_TOP)/lib/erl_interface/bin/$(TARGET) vpath %.c connect:encode:decode:misc:epmd:legacy:registry - ########################################################################### # List targets ########################################################################### @@ -202,11 +201,6 @@ ifeq ($(USING_VC),yes) # Windows targets TARGETS = \ - $(BINDIR) \ - $(OBJDIR) \ - $(MT_OBJDIR) \ - $(MD_OBJDIR) \ - $(MDD_OBJDIR) \ $(OBJ_TARGETS) \ $(EXE_TARGETS) @@ -236,9 +230,6 @@ else ifeq ($USING_MINGW,yes) TARGETS = \ - $(BINDIR) \ - $(OBJDIR) \ - $(MD_OBJDIR) \ $(OBJ_TARGETS) \ $(EXE_TARGETS) @@ -257,10 +248,6 @@ else ifdef THR_DEFS TARGETS = \ - $(BINDIR) \ - $(OBJDIR) \ - $(ST_OBJDIR) \ - $(MT_OBJDIR) \ $(OBJ_TARGETS) \ $(EXE_TARGETS) @@ -283,9 +270,6 @@ FAKE_TARGETS = \ else TARGETS = \ - $(BINDIR) \ - $(OBJDIR) \ - $(ST_OBJDIR) \ $(OBJ_TARGETS) \ $(EXE_TARGETS) @@ -601,23 +585,7 @@ $(MDD_OBJDIR)/%.o: %.c # Create directories ########################################################################### -$(BINDIR): - mkdir -p $(BINDIR) - -$(OBJDIR): - mkdir -p $(OBJDIR) - -$(ST_OBJDIR): - mkdir -p $(ST_OBJDIR) - -$(MT_OBJDIR): - mkdir -p $(MT_OBJDIR) - -$(MD_OBJDIR): - mkdir -p $(MD_OBJDIR) - -$(MDD_OBJDIR): - mkdir -p $(MDD_OBJDIR) +_create_dirs := $(shell mkdir -p $(BINDIR) $(OBJDIR) $(ST_OBJDIR) $(MT_OBJDIR) $(MD_OBJDIR) $(MDD_OBJDIR)) ########################################################################### # Special rules diff --git a/lib/eunit/src/Makefile b/lib/eunit/src/Makefile index 4897c20ec1..bec2fdbe0b 100644 --- a/lib/eunit/src/Makefile +++ b/lib/eunit/src/Makefile @@ -26,8 +26,9 @@ INCLUDE=../include ERL_COMPILE_FLAGS += -pa $(EBIN) -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard +PARSE_TRANSFORM = eunit_autoexport.erl + SOURCES= \ - eunit_autoexport.erl \ eunit_striptests.erl \ eunit.erl \ eunit_tests.erl \ @@ -43,6 +44,8 @@ SOURCES= \ INCLUDE_FILES = eunit.hrl +PARSE_TRANSFORM_BIN = $(PARSE_TRANSFORM:%.erl=$(EBIN)/%.$(EMULATOR)) + OBJECTS=$(SOURCES:%.erl=$(EBIN)/%.$(EMULATOR)) $(APP_TARGET) $(APPUP_TARGET) INCLUDE_DELIVERABLES = $(INCLUDE_FILES:%=$(INCLUDE)/%) @@ -59,7 +62,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) # Targets # ---------------------------------------------------- -debug opt: $(OBJECTS) +debug opt: $(PARSE_TRANSFORM_BIN) $(OBJECTS) docs: @@ -86,6 +89,8 @@ realclean: clean $(EBIN)/%.$(EMULATOR):%.erl erlc -W $(ERL_COMPILE_FLAGS) -o$(EBIN) $< +$(OBJECTS): $(PARSE_TRANSFORM_BIN) + # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- @@ -103,9 +108,9 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(OBJECTS) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(PARSE_TRANSFORM_BIN) $(OBJECTS) $(RELSYSDIR)/ebin $(INSTALL_DIR) $(RELSYSDIR)/src - $(INSTALL_DATA) $(SOURCES) $(RELSYSDIR)/src + $(INSTALL_DATA) $(PARSE_TRANSFORM) $(SOURCES) $(RELSYSDIR)/src $(INSTALL_DIR) $(RELSYSDIR)/include $(INSTALL_DATA) $(INCLUDE_DELIVERABLES) $(RELSYSDIR)/include diff --git a/lib/gs/src/Makefile b/lib/gs/src/Makefile index a648d3cf13..b3f11fb71b 100644 --- a/lib/gs/src/Makefile +++ b/lib/gs/src/Makefile @@ -90,7 +90,7 @@ clean: # Special Build Targets # ---------------------------------------------------- -gstk_generic.hrl: gs_make.erl +gstk_generic.hrl: gs_make.erl ../ebin/gs.$(EMULATOR) $(ERL) -pa $(EBIN) -s gs_make -s erlang halt -noshell $(APP_TARGET): $(APP_SRC) ../vsn.mk @@ -99,6 +99,8 @@ $(APP_TARGET): $(APP_SRC) ../vsn.mk $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk sed -e 's;%VSN%;$(VSN);' $< > $@ +$(GSTK_GENERIC_TARGET): gstk_generic.hrl + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 4163f2dae2..1483b2aee1 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -678,8 +678,6 @@ type(erlang, check_old_code, 1, Xs) -> type(erlang, check_process_code, 2, Xs) -> strict(arg_types(erlang, check_process_code, 2), Xs, fun (_) -> t_boolean() end); -type(erlang, concat_binary, 1, Xs) -> - strict(arg_types(erlang, concat_binary, 1), Xs, fun (_) -> t_binary() end); type(erlang, crc32, 1, Xs) -> strict(arg_types(erlang, crc32, 1), Xs, fun (_) -> t_crc32() end); type(erlang, crc32, 2, Xs) -> @@ -801,7 +799,8 @@ type(erlang, get_module_info, 2, Xs) -> end end); type(erlang, get_stacktrace, 0, _) -> - t_list(t_tuple([t_atom(), t_atom(), t_sup([t_arity(), t_list()])])); + t_list(t_tuple([t_atom(), t_atom(), t_sup([t_arity(), t_list()]), + t_list()])); type(erlang, group_leader, 0, _) -> t_pid(); type(erlang, group_leader, 2, Xs) -> strict(arg_types(erlang, group_leader, 2), Xs, @@ -3446,8 +3445,6 @@ arg_types(erlang, check_old_code, 1) -> [t_atom()]; arg_types(erlang, check_process_code, 2) -> [t_pid(), t_atom()]; -arg_types(erlang, concat_binary, 1) -> - [t_list(t_binary())]; arg_types(erlang, crc32, 1) -> [t_iodata()]; arg_types(erlang, crc32, 2) -> @@ -3763,7 +3760,10 @@ arg_types(erlang, purge_module, 1) -> arg_types(erlang, put, 2) -> [t_any(), t_any()]; arg_types(erlang, raise, 3) -> - [t_raise_errorclass(), t_any(), type(erlang, get_stacktrace, 0, [])]; + OldStyleType = t_list(t_tuple([t_atom(), t_atom(), + t_sup([t_arity(), t_list()])])), + NewStyleType = type(erlang, get_stacktrace, 0, []), + [t_raise_errorclass(), t_any(), t_sup(OldStyleType, NewStyleType)]; arg_types(erlang, read_timer, 1) -> [t_reference()]; arg_types(erlang, ref_to_list, 1) -> diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index cfed410240..45b390acbd 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -281,10 +281,14 @@ needs_redtest(Leafness) -> %%----------------------------------------------------------------------- %%--- label & func_info combo --- +trans_fun([{label,_}=F,{func_info,_,_,_}=FI|Instructions], Env) -> + %% Handle old code without a line instruction. + trans_fun([F,{line,[]},FI|Instructions], Env); trans_fun([{label,B},{label,_}, {func_info,M,F,A},{label,L}|Instructions], Env) -> trans_fun([{label,B},{func_info,M,F,A},{label,L}|Instructions], Env); trans_fun([{label,B}, + {line,_}, {func_info,{atom,_M},{atom,_F},_A}, {label,L}|Instructions], Env) -> %% Emit code to handle function_clause errors. The BEAM test instructions @@ -1142,6 +1146,11 @@ trans_fun([{trim,N,NY}|Instructions], Env) -> Moves = trans_trim(N, NY), Moves ++ trans_fun(Instructions, Env); %%-------------------------------------------------------------------- +%% New line/1 instruction in R15. +%%-------------------------------------------------------------------- +trans_fun([{line,_}|Instructions], Env) -> + trans_fun(Instructions,Env); +%%-------------------------------------------------------------------- %%--- ERROR HANDLING --- %%-------------------------------------------------------------------- trans_fun([X|_], _) -> @@ -1869,6 +1878,8 @@ patch_make_funs([], FunIndex, Acc) -> find_mfa([{label,_}|Code]) -> find_mfa(Code); +find_mfa([{line,_}|Code]) -> + find_mfa(Code); find_mfa([{func_info,{atom,M},{atom,F},A}|_]) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> {M, F, A}. diff --git a/lib/ic/c_src/Makefile.in b/lib/ic/c_src/Makefile.in index 6eef7827b9..28040ca42d 100644 --- a/lib/ic/c_src/Makefile.in +++ b/lib/ic/c_src/Makefile.in @@ -125,13 +125,9 @@ docs: # Special Build Targets # ---------------------------------------------------- -$(OBJDIR): - -mkdir -p $(OBJDIR) +_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) -$(LIBDIR): - -mkdir -p $(LIBDIR) - -$(LIBRARY): $(OBJDIR) $(LIBDIR) $(OBJ_FILES) +$(LIBRARY): $(OBJ_FILES) -$(AR) $(AR_OUT) $@ $(OBJ_FILES) -$(RANLIB) $@ diff --git a/lib/ic/examples/pre_post_condition/Makefile b/lib/ic/examples/pre_post_condition/Makefile index 68e2168e1e..85cbbdb9ff 100644 --- a/lib/ic/examples/pre_post_condition/Makefile +++ b/lib/ic/examples/pre_post_condition/Makefile @@ -108,9 +108,14 @@ docs: test: $(TEST_TARGET_FILES) -$(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES): ex.idl +IDL-GENERATED: ex.idl erlc $(ERL_LOCAL_FLAGS) +'{precond,{tracer,pre}}' \ +'{{postcond,"m::i::f"},{tracer,post}}' ex.idl + >IDL-GENERATED + +$(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/ic/java_src/com/ericsson/otp/ic/ignore_config_record.inf b/lib/ic/java_src/com/ericsson/otp/ic/ignore_config_record.inf deleted file mode 100644 index 34e5586175..0000000000 --- a/lib/ic/java_src/com/ericsson/otp/ic/ignore_config_record.inf +++ /dev/null @@ -1 +0,0 @@ -Dummy to speed up compilatio diff --git a/lib/inets/doc/src/httpc.xml b/lib/inets/doc/src/httpc.xml index d1671ac9bd..b1f964ae69 100644 --- a/lib/inets/doc/src/httpc.xml +++ b/lib/inets/doc/src/httpc.xml @@ -28,8 +28,10 @@ <date></date> <rev></rev> </header> + <module>httpc</module> <modulesummary>An HTTP/1.1 client </modulesummary> + <description> <p>This module provides the API to a HTTP/1.1 compatible client according to RFC 2616, caching is currently not supported.</p> @@ -167,7 +169,6 @@ filename() = string() <v>http_option() = {timeout, timeout()} | {connect_timeout, timeout()} | {ssl, ssloptions()} | - {ossl, ssloptions()} | {essl, ssloptions()} | {autoredirect, boolean()} | {proxy_auth, {userstring(), passwordstring()}} | @@ -206,6 +207,7 @@ filename() = string() to the <c>receiver</c> depending on that value. </p> <p>Http option (<c>http_option()</c>) details: </p> + <marker id="request2_http_options"></marker> <taglist> <tag><c><![CDATA[timeout]]></c></tag> <item> @@ -231,16 +233,9 @@ filename() = string() <p>Defaults to <c>[]</c>. </p> </item> - <tag><c><![CDATA[ossl]]></c></tag> - <item> - <p>If using the OpenSSL based (old) implementation of SSL, - these SSL-specific options are used. </p> - <p>Defaults to <c>[]</c>. </p> - </item> - <tag><c><![CDATA[essl]]></c></tag> <item> - <p>If using the Erlang based (new) implementation of SSL, + <p>If using the Erlang based implementation of SSL, these SSL-specific options are used. </p> <p>Defaults to <c>[]</c>. </p> </item> diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index edacb73b65..f88099a82e 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -148,13 +148,11 @@ in the apache like configuration file. </item> - <tag>{socket_type, ip_comm | ssl | ossl | essl}</tag> + <tag>{socket_type, ip_comm | ssl | essl}</tag> <item> - <p>When using ssl, there are several alternatives. - <c>ossl</c> specifically uses the OpenSSL based (old) SSL. - <c>essl</c> specifically uses the Erlang based (new) SSL. - When using <c>ssl</c> it <em>currently</em> defaults to - <c>essl</c>. </p> + <p>When using ssl, there are currently only one alternative. + <c>essl</c> specifically uses the Erlang based SSL. + <c>ssl</c> defaults to <c>essl</c>. </p> <p>Defaults to <c>ip_comm</c>. </p> </item> @@ -162,7 +160,7 @@ <item> <p>Defaults to <c>inet6fb4. </c> </p> <p>Note that this option is only used when the option - <c>socket_type</c> has the value <c>ip_comm</c>. </p> + <c>socket_type</c> has the value <c>ip_comm</c>. </p> </item> </taglist> diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index 34f26bf45b..c53aa653d8 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -32,6 +32,68 @@ <file>notes.xml</file> </header> + <section><title>Inets 5.8</title> + + <section><title>Improvements and New Features</title> + <p>-</p> + +<!-- + <list> + <item> + <p>[httpc|httpd] Added support for IPv6 with ssl. </p> + <p>Own Id: OTP-5566</p> + </item> + + </list> +--> + + </section> + + <section><title>Fixed Bugs and Malfunctions</title> + <p>-</p> + +<!-- + <list> + <item> + <p>[httpc] Remove unnecessary usage of iolist_to_binary when + processing body (for PUT and POST). </p> + <p>Filipe David Manana</p> + <p>Own Id: OTP-9317</p> + </item> + + </list> +--> + + </section> + + <section> + <title>Incompatibilities</title> +<!-- + <p>-</p> +--> + + <list> + <item> + <p>[httpc] Deprecated interface module <c>http</c> has been removed. + It has (long) been replaced by http client interface module + <seealso marker="httpc#">httpc</seealso>. </p> + <p>Own Id: OTP-9359</p> + </item> + + <item> + <p>[httpc|httpd] The old ssl implementation (based on OpenSSL), + has been deprecated. The config option that specified usage of + this version of the ssl app, <c>ossl</c>, has been removed. </p> + <p>Own Id: OTP-9522</p> + </item> + + </list> + + </section> + + </section> <!-- 5.8 --> + + <section><title>Inets 5.7</title> <section><title>Improvements and New Features</title> @@ -1044,570 +1106,11 @@ </section> <!-- 5.1 --> + <!-- + <p>For information about older versions see + <url href="part_notes_history_frame.html">release notes history</url>.</p> + --> - <section><title>Inets 5.0.14</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [tftp] The callback watchdog has been removed, as it - turned out to be counter productive when the disk was - overloaded. Earlier a connection was aborted when a - callback (which performs the file access in the TFTP - server) took too long time.</p> - <p> - [tftp] The error message "Too many connections" has been - reclassified to be a warning.</p> - <p> - Own Id: OTP-7888</p> - </item> - </list> - </section> - - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p>[httpc] - Incorrect http version option check. </p> - <p>Mats Cronqvist</p> - <p>Own Id: OTP-7882</p> - </item> - - <item> - <p>[httpc] - Unnecessary error report when client - terminating as a result of the server closed the - socket unexpectedly. </p> - <p>Own Id: OTP-7883</p> - </item> - - <item> - <p>[httpc] - Failed transforming a relative URI to - an absolute URI. </p> - <p>[email protected]</p> - <p>Own Id: OTP-7950</p> - </item> - - <item> - <p>[httpd] - The HTTP server did not handle the config - option ssl_ca_certificate_file. </p> - <p>[email protected]</p> - <p>Own Id: OTP-7976</p> - </item> - - </list> - </section> - - </section> <!-- 5.0.14 --> - - - <section><title>Inets 5.0.13</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Ssl did not work correctly with the use of new style - configuration due to sn old internal format that was not - changed correctly in all places.</p> - <p> - Own Id: OTP-7723 Aux Id: seq11143 </p> - </item> - <item> - <p> - [httpc] - Now streams 200 and 206 results and not only - 200 results.</p> - <p> - Own Id: OTP-7857</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpc] - The inets http client will now use persistent - connections without pipelining as default and if a - pipeline timeout is set it will pipeline the requests on - the persistent connections.</p> - <p> - *** POTENTIAL INCOMPATIBILITY ***</p> - <p> - Own Id: OTP-7463</p> - </item> - <item> - <p> - [httpd] - added option ssl_password_callback_arguments.</p> - <p> - Own Id: OTP-7724 Aux Id: seq11151 </p> - </item> - <item> - <p> - Changed the socket use so that it will become more robust - to non-functional ipv6 and fallback on ipv4. This changes - may for very special os-configurations cause a problem - when used with erts-versions pre R13.</p> - <p> - Own Id: OTP-7726</p> - </item> - <item> - <p> - Removed deprecated function httpd_util:key1search/[2,3]</p> - <p> - Own Id: OTP-7815</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.12</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpd] - Updated inets so that it not uses the deprecated - function ssl:accept/[2,3].</p> - <p> - Own Id: OTP-7636 Aux Id: seq11086 </p> - </item> - </list> - </section> - - </section> - - - <section><title>Inets 5.0.11</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Transient bug related to hot code swap of the TFTP server is - now fixed. It could happen that the first TFTP server that was - started after a code upgrade to Inets-5.0.6 crashed with a - function clause error in tftp_engine:service_init/2.</p> - <p> Own Id: OTP-7574 Aux Id: seq11069 </p> - </item> - <item> - <p> - [httpd] - Validation of ssl_password_callback_module was - incorrect.</p> - <p> - Own Id: OTP-7597 Aux Id: seq11074 </p> - </item> - <item> - <p> - [httpd] - Misspelling in old apachelike configuration - directive TransferDiskLogSize has been corrected.</p> - <p> Own Id: OTP-7598 Aux Id: seq11059 </p> - </item> - <item> - <p> - Minor problems found by dialyzer has been fixed.</p> - <p> - Own Id: OTP-7605</p> - </item> - </list> - </section> - - </section> - -<section><title>Inets 5.0.10</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Enhanched an info report.</p> - <p> - Own Id: OTP-7450</p> - </item> - </list> - </section> - - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Changed errro message from - {wrong_type,{document_root,"/tmp/htdocs"}} to - {invalid_option,{non_existing, - document_root,"/tmp/htdocs"}}.</p> - <p> - Own Id: OTP-7454</p> - </item> - <item> - <p> - Relative paths in directory authentication did not work - as intended, this has now been fixed.</p> - <p> - Own Id: OTP-7490</p> - </item> - <item> - <p> - The query-string passed to the callback function was not - compliant with the documentation, it is now.</p> - <p> - Own Id: OTP-7512</p> - </item> - </list> - </section> - -</section> - - <section><title>Inets 5.0.9</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - Parameters to error_logger:error_report/1 has been - corrected.</p> - <p> - Own Id: OTP-7257 Aux Id: OTP-7294, OTP-7258 </p> - </item> - <item> - <p> - [httpd] - If a Module/Function request matching an - erl_script_alias registration does not exist as a function in - the module registered a 404 error will now be issued instead of a - 500 error.</p> - <p> - Own Id: OTP-7323</p> - </item> - <item> - <p> - [httpd] -The option auth_type for mod_auth is no longer - mandatory, for backward-compatibility reasons.</p> - <p> - Own Id: OTP-7341</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.8</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - [httpd] - Spelling error caused client connection header - to be ignored.</p> - <p> - Own Id: OTP-7315 Aux Id: seq10951 </p> - </item> - <item> - <p> - [httpd] - Call to the function - mod_get:get_modification_date/1 was made too early - resulting in that httpd did not send the 404 file missing - response.</p> - <p> - Own Id: OTP-7321</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.7</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpc, httpd] - Now follows the recommendation regarding - line terminators in section 19.3 in RFC 2616 e.i: "The - line terminator for message-header fields is the sequence - CRLF. However, we recommend that applications, when - parsing such headers, recognize a single LF as a line - terminator and ignore the leading CR".</p> - <p> - Own Id: OTP-7304 Aux Id: seq10944 </p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.6</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [tftp] If a callback (which performs the file access in - the TFTP server) takes too long time (more than the - double TFTP timeout), the server will abort the - connection and send an error reply to the client. This - implies that the server will release resources attached - to the connection faster than before. The server simply - assumes that the client has given up.</p> - <p> - [tftp] If the TFTP server receives yet another request - from the same client (same host and port) while it - already has an active connection to the client, it will - simply ignore the new request if the request is equal - with the first one (same filename and options). This - implies that the (new) client will be served by the - already ongoing connection on the server side. By not - setting up yet another connection, in parallel with the - ongoing one, the server will consumer lesser resources.</p> - <p> - [tftp] netascii mode is now supported when the - client/server has native ascii support (Windows). The new - optional parameter native_ascii in the tftp_binary and - tftp_file callback modules can be used to override the - default behavior.</p> - <p> - [tftp] Yet another callback module has been added in - order to allow customized handling of error, warning and - info messages. See the new configuration parameter, - logger.</p> - <p> - [tftp] Yet another configuration parameter, max_retries, - has been added in order to control the number of times a - packet can be resent. The default is 5.</p> - <p> - [tftp] tftp:info/1 and tftp:change_config/2 can now be - applied to all daemons or all servers in one command - without bothering about their process identifiers.</p> - <p> - External TR HI89527.</p> - <p> - Own Id: OTP-7266</p> - </item> - </list> - </section> - -</section> - -<section><title>Inets 5.0.5</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [tftp] Blocks with too low block numbers are silently - discarded. For example if a server receives block #5 when - it expects block #7 it will discard the block without - interrupting the file transfer. Too high block numbers - does still imply an error. External TR HI96072.</p> - <p> - Own Id: OTP-7220</p> - </item> - <item> - <p> - [tftp] The problem with occasional case_clause errors in - tftp_engine:common_read/7 has been fixed. External TR - HI97362.</p> - <p> - Own Id: OTP-7221</p> - </item> - </list> - </section> - -</section> - - <section><title>Inets 5.0.4</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Changed calls to file open to concur with the API and not - use deprecated syntax.</p> - <p> - Own Id: OTP-7172</p> - </item> - <item> - <p> - [tftp] Server lost the first packet when the client timed - out</p> - <p> - Own Id: OTP-7173</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.3</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - Updated copyright headers and fixed backwards - compatibility for an undocumented feature, for now. This - feature will later be removed and a new and documented - option will take its place.</p> - <p> - Own Id: OTP-7144</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.2</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpd] - Error logs now has a pretty and a compact - format and access logs can be written on the common log - format or the extended common log format.</p> - <p> - Own Id: OTP-6661 Aux Id: Seq 7764 </p> - </item> - <item> - <p> - [httpc] - Added acceptance of missing reason phrase to - the relaxed mode.</p> - <p> - Own Id: OTP-7024</p> - </item> - <item> - <p> - [httpc] - A new option has been added to enable the - client to act as lower version clients, by default the - client is an HTTP/1.1 client.</p> - <p> - Own Id: OTP-7043</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0.1</title> - - <section><title>Fixed Bugs and Malfunctions</title> - <list> - <item> - <p> - [httpd] - Deprecated function httpd:start/1 did not - accept all inputs that it had done previously. This - should now work again.</p> - <p> - Own Id: OTP-7040</p> - </item> - </list> - </section> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpd] - Changed validity check on bind_address so that - it uses inet:getaddr instead of inet:gethostbyaddr as the - former puts a too hard restriction on the bind_address.</p> - <p> - Own Id: OTP-7041 Aux Id: seq10829 </p> - </item> - <item> - <p> - [httpc] - Internal process now does try-catch and - terminates normally in case of HTTP parse errors. - Semantical the client works just as before returning an - error message to the client, even if the error massage - has been enhanced, but there is no supervisor report in - the shell of a internal process crashing. (Which was the - expected behavior and not a fault.)</p> - <p> - Own Id: OTP-7042</p> - </item> - </list> - </section> - - </section> - - <section><title>Inets 5.0</title> - - <section><title>Improvements and New Features</title> - <list> - <item> - <p> - [httpd, httpc] - Deprecated base64 decode/encode - functions have been removed. Inets uses base64 in STDLIB - instead.</p> - <p> - *** POTENTIAL INCOMPATIBILITY ***</p> - <p> - Own Id: OTP-6485</p> - </item> - <item> - <p> - [httpd] - It is now possible to restrict the length of - acceptable URI:s in the HTTP server.</p> - <p> - Own Id: OTP-6572</p> - </item> - <item> - <p> - [httpc] - Profiles are now supported i.e. the options - available in set_options/1 can be set locally for a - certain profile and do not have to affect all - HTTP-requests issued in the Erlang node. Calls to the - HTTP client API functions not using the profile argument - will use the default profile.</p> - <p> - Own Id: OTP-6690</p> - </item> - <item> - <p> - A new uniform Inets interface provides a flexible way to - start/stop Inets services and get information about - running services. See inets(3). This also means that - inflexibilities in the HTTP server has been removed and - more default values has been added.</p> - <p> - Own Id: OTP-6705</p> - </item> - <item> - <p> - [tftp] Logged errors have been changed to be logged - warnings.</p> - <p> - Own Id: OTP-6916 Aux Id: seq10737 </p> - </item> - <item> - <p> - [httpc] - The client will now return the proper value - when receiving a HTTP 204 code instead of hanging.</p> - <p> - Own Id: OTP-6982</p> - </item> - <item> - <p> - The Inets application now has to be explicitly started - and stopped i.e. it will not automatically be started as - a temporary application as it did before. Although a - practical feature when testing things in the shell it is - not desirable that people take advantage of this and not - start the Inets application in a correct way in their - products. Added functions to the Inets API that call - application:start/stop.</p> - <p> - *** POTENTIAL INCOMPATIBILITY ***</p> - <p> - Own Id: OTP-6993</p> - </item> - </list> - </section> - - <!-- p>For information about older versions see - <url href="part_notes_history_frame.html">release notes history</url>.</p --> - </section> </chapter> diff --git a/lib/inets/src/http_client/Makefile b/lib/inets/src/http_client/Makefile index 0397b48ab2..3960c36d00 100644 --- a/lib/inets/src/http_client/Makefile +++ b/lib/inets/src/http_client/Makefile @@ -41,7 +41,6 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- MODULES = \ - http \ httpc \ httpc_cookie \ httpc_handler \ diff --git a/lib/inets/src/http_client/http.erl b/lib/inets/src/http_client/http.erl deleted file mode 100644 index bbe2fec267..0000000000 --- a/lib/inets/src/http_client/http.erl +++ /dev/null @@ -1,132 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2010. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% -%% - -%%% Description: OLD API MODULE - USE httpc INSTEAD - --module(http). - --deprecated({request, 1, next_major_release}). --deprecated({request, 2, next_major_release}). --deprecated({request, 4, next_major_release}). --deprecated({request, 5, next_major_release}). --deprecated({cancel_request, 1, next_major_release}). --deprecated({cancel_request, 2, next_major_release}). --deprecated({set_option, 2, next_major_release}). --deprecated({set_option, 3, next_major_release}). --deprecated({set_options, 1, next_major_release}). --deprecated({set_options, 2, next_major_release}). --deprecated({verify_cookies, 2, next_major_release}). --deprecated({verify_cookies, 3, next_major_release}). --deprecated({cookie_header, 1, next_major_release}). --deprecated({cookie_header, 2, next_major_release}). --deprecated({stream_next, 1, next_major_release}). --deprecated({default_profile, 0, next_major_release}). - -%% Deprecated --export([ - request/1, request/2, request/4, request/5, - cancel_request/1, cancel_request/2, - set_option/2, set_option/3, - set_options/1, set_options/2, - verify_cookies/2, verify_cookies/3, - cookie_header/1, cookie_header/2, - stream_next/1, - default_profile/0 - ]). - - -%%%========================================================================= -%%% API -%%%========================================================================= - -%%-------------------------------------------------------------------------- -%% request(Url [, Profile]) -> -%% request(Method, Request, HTTPOptions, Options [, Profile]) -%%-------------------------------------------------------------------------- - -request(Url) -> httpc:request(Url). -request(Url, Profile) -> httpc:request(Url, Profile). - -request(Method, Request, HttpOptions, Options) -> - httpc:request(Method, Request, HttpOptions, Options). -request(Method, Request, HttpOptions, Options, Profile) -> - httpc:request(Method, Request, HttpOptions, Options, Profile). - - -%%-------------------------------------------------------------------------- -%% cancel_request(RequestId [, Profile]) -%%------------------------------------------------------------------------- - -cancel_request(RequestId) -> - httpc:cancel_request(RequestId). -cancel_request(RequestId, Profile) -> - httpc:cancel_request(RequestId, Profile). - - -%%-------------------------------------------------------------------------- -%% set_options(Options [, Profile]) -%% set_option(Key, Value [, Profile]) -%%------------------------------------------------------------------------- - -set_options(Options) -> - httpc:set_options(Options). -set_options(Options, Profile) -> - httpc:set_options(Options, Profile). - -set_option(Key, Value) -> - httpc:set_option(Key, Value). -set_option(Key, Value, Profile) -> - httpc:set_option(Key, Value, Profile). - - -%%-------------------------------------------------------------------------- -%% verify_cookies(SetCookieHeaders, Url [, Profile]) -%%------------------------------------------------------------------------- - -verify_cookies(SetCookieHeaders, Url) -> - httpc:store_cookies(SetCookieHeaders, Url). -verify_cookies(SetCookieHeaders, Url, Profile) -> - httpc:store_cookies(SetCookieHeaders, Url, Profile). - - -%%-------------------------------------------------------------------------- -%% cookie_header(Url [, Profile]) -%%------------------------------------------------------------------------- - -cookie_header(Url) -> - httpc:cookie_header(Url). -cookie_header(Url, Profile) -> - httpc:cookie_header(Url, Profile). - - -%%-------------------------------------------------------------------------- -%% stream_next(Pid) -%%------------------------------------------------------------------------- - -stream_next(Pid) -> - httpc:stream_next(Pid). - - -%%-------------------------------------------------------------------------- -%% default_profile() -%%------------------------------------------------------------------------- - -default_profile() -> - httpc:default_profile(). diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index fe8e93af1f..75c26c63cc 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -105,7 +105,6 @@ request(Url, Profile) -> %% {ssl, SSLOptions} | {proxy_auth, {User, Password}} %% Ssloptions = ssl_options() | %% {ssl, ssl_options()} | -%% {ossl, ssl_options()} | %% {essl, ssl_options()} %% ssl_options() = [ssl_option()] %% ssl_option() = {verify, code()} | @@ -644,8 +643,6 @@ http_options_default() -> {ok, {?HTTP_DEFAULT_SSL_KIND, Value}}; ({ssl, SslOptions}) when is_list(SslOptions) -> {ok, {?HTTP_DEFAULT_SSL_KIND, SslOptions}}; - ({ossl, SslOptions}) when is_list(SslOptions) -> - {ok, {ossl, SslOptions}}; ({essl, SslOptions}) when is_list(SslOptions) -> {ok, {essl, SslOptions}}; (_) -> diff --git a/lib/inets/src/http_lib/http_internal.hrl b/lib/inets/src/http_lib/http_internal.hrl index 2e924667c6..97cf474ab9 100644 --- a/lib/inets/src/http_lib/http_internal.hrl +++ b/lib/inets/src/http_lib/http_internal.hrl @@ -28,7 +28,6 @@ -define(HTTP_MAX_URI_SIZE, nolimit). -ifndef(HTTP_DEFAULT_SSL_KIND). -%% -define(HTTP_DEFAULT_SSL_KIND, ossl). -define(HTTP_DEFAULT_SSL_KIND, essl). -endif. % -ifdef(HTTP_DEFAULT_SSL_KIND). diff --git a/lib/inets/src/http_lib/http_transport.erl b/lib/inets/src/http_lib/http_transport.erl index 9b8190ebed..5eb827032f 100644 --- a/lib/inets/src/http_lib/http_transport.erl +++ b/lib/inets/src/http_lib/http_transport.erl @@ -62,8 +62,6 @@ start(ip_comm) -> %% This is just for backward compatibillity start({ssl, _}) -> do_start_ssl(); -start({ossl, _}) -> - do_start_ssl(); start({essl, _}) -> do_start_ssl(). @@ -126,22 +124,6 @@ connect(ip_comm = _SocketType, {Host, Port}, Opts0, Timeout) connect({ssl, SslConfig}, Address, Opts, Timeout) -> connect({?HTTP_DEFAULT_SSL_KIND, SslConfig}, Address, Opts, Timeout); -connect({ossl, SslConfig}, {Host, Port}, _, Timeout) -> - Opts = [binary, {active, false}, {ssl_imp, old}] ++ SslConfig, - ?hlrt("connect using ossl", - [{host, Host}, - {port, Port}, - {ssl_config, SslConfig}, - {timeout, Timeout}]), - case (catch ssl:connect(Host, Port, Opts, Timeout)) of - {'EXIT', Reason} -> - {error, {eoptions, Reason}}; - {ok, _} = OK -> - OK; - {error, _} = ERROR -> - ERROR - end; - connect({essl, SslConfig}, {Host, Port}, Opts0, Timeout) -> Opts = [binary, {active, false}, {ssl_imp, new} | Opts0] ++ SslConfig, ?hlrt("connect using essl", @@ -187,13 +169,6 @@ listen({ssl, SSLConfig}, Addr, Port) -> {ssl_config, SSLConfig}]), listen({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Addr, Port); -listen({ossl, SSLConfig}, Addr, Port) -> - ?hlrt("listen (ossl)", - [{addr, Addr}, - {port, Port}, - {ssl_config, SSLConfig}]), - listen_ssl(Addr, Port, [{ssl_imp, old} | SSLConfig]); - listen({essl, SSLConfig}, Addr, Port) -> ?hlrt("listen (essl)", [{addr, Addr}, @@ -353,8 +328,6 @@ accept(ip_comm, ListenSocket, Timeout) -> accept({ssl, SSLConfig}, ListenSocket, Timeout) -> accept({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, ListenSocket, Timeout); -accept({ossl, _SSLConfig}, ListenSocket, Timeout) -> - ssl:transport_accept(ListenSocket, Timeout); accept({essl, _SSLConfig}, ListenSocket, Timeout) -> ssl:transport_accept(ListenSocket, Timeout). @@ -374,9 +347,6 @@ controlling_process(ip_comm, Socket, NewOwner) -> controlling_process({ssl, SSLConfig}, Socket, NewOwner) -> controlling_process({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, NewOwner); -controlling_process({ossl, _}, Socket, NewOwner) -> - ssl:controlling_process(Socket, NewOwner); - controlling_process({essl, _}, Socket, NewOwner) -> ssl:controlling_process(Socket, NewOwner). @@ -397,13 +367,6 @@ setopts(ip_comm, Socket, Options) -> setopts({ssl, SSLConfig}, Socket, Options) -> setopts({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Options); -setopts({ossl, _}, Socket, Options) -> - ?hlrt("[o]ssl setopts", [{socket, Socket}, {options, Options}]), - Reason = (catch ssl:setopts(Socket, Options)), - ?hlrt("[o]ssl setopts result", [{reason, Reason}]), - Reason; - - setopts({essl, _}, Socket, Options) -> ?hlrt("[e]ssl setopts", [{socket, Socket}, {options, Options}]), Reason = (catch ssl:setopts(Socket, Options)), @@ -435,10 +398,6 @@ getopts(ip_comm, Socket, Options) -> getopts({ssl, SSLConfig}, Socket, Options) -> getopts({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Options); -getopts({ossl, _}, Socket, Options) -> - ?hlrt("ssl getopts", [{socket, Socket}, {options, Options}]), - getopts_ssl(Socket, Options); - getopts({essl, _}, Socket, Options) -> ?hlrt("essl getopts", [{socket, Socket}, {options, Options}]), getopts_ssl(Socket, Options). @@ -472,9 +431,6 @@ getstat(ip_comm = _SocketType, Socket) -> getstat({ssl, SSLConfig}, Socket) -> getstat({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); -getstat({ossl, _} = _SocketType, _Socket) -> - []; - getstat({essl, _} = _SocketType, _Socket) -> []. @@ -493,9 +449,6 @@ send(ip_comm, Socket, Message) -> send({ssl, SSLConfig}, Socket, Message) -> send({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Message); -send({ossl, _}, Socket, Message) -> - ssl:send(Socket, Message); - send({essl, _}, Socket, Message) -> ssl:send(Socket, Message). @@ -514,9 +467,6 @@ close(ip_comm, Socket) -> close({ssl, SSLConfig}, Socket) -> close({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); -close({ossl, _}, Socket) -> - ssl:close(Socket); - close({essl, _}, Socket) -> ssl:close(Socket). @@ -538,9 +488,6 @@ peername(ip_comm, Socket) -> peername({ssl, SSLConfig}, Socket) -> peername({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); -peername({ossl, _}, Socket) -> - do_peername(ssl:peername(Socket)); - peername({essl, _}, Socket) -> do_peername(ssl:peername(Socket)). @@ -573,9 +520,6 @@ sockname(ip_comm, Socket) -> sockname({ssl, SSLConfig}, Socket) -> sockname({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket); -sockname({ossl, _}, Socket) -> - do_sockname(ssl:sockname(Socket)); - sockname({essl, _}, Socket) -> do_sockname(ssl:sockname(Socket)). @@ -651,9 +595,6 @@ negotiate(ip_comm,_,_) -> negotiate({ssl, SSLConfig}, Socket, Timeout) -> ?hlrt("negotiate(ssl)", []), negotiate({?HTTP_DEFAULT_SSL_KIND, SSLConfig}, Socket, Timeout); -negotiate({ossl, _}, Socket, Timeout) -> - ?hlrt("negotiate(ossl)", []), - negotiate_ssl(Socket, Timeout); negotiate({essl, _}, Socket, Timeout) -> ?hlrt("negotiate(essl)", []), negotiate_ssl(Socket, Timeout). diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index d1b1ea0e14..1ff73d756b 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -219,9 +219,8 @@ load("ServerName " ++ ServerName, []) -> load("SocketType " ++ SocketType, []) -> %% ssl is the same as HTTP_DEFAULT_SSL_KIND - %% ossl is ssl based on OpenSSL (the "old" ssl) %% essl is the pure Erlang-based ssl (the "new" ssl) - case check_enum(clean(SocketType), ["ssl", "ossl", "essl", "ip_comm"]) of + case check_enum(clean(SocketType), ["ssl", "essl", "ip_comm"]) of {ok, ValidSocketType} -> {ok, [], {socket_type, ValidSocketType}}; {error,_} -> @@ -541,7 +540,6 @@ validate_config_params([{server_name, Value} | _]) -> validate_config_params([{socket_type, Value} | Rest]) when (Value =:= ip_comm) orelse (Value =:= ssl) orelse - (Value =:= ossl) orelse (Value =:= essl) -> validate_config_params(Rest); validate_config_params([{socket_type, Value} | _]) -> @@ -811,7 +809,7 @@ lookup_socket_type(ConfigDB) -> case httpd_util:lookup(ConfigDB, socket_type, ip_comm) of ip_comm -> ip_comm; - SSL when (SSL =:= ssl) orelse (SSL =:= ossl) orelse (SSL =:= essl) -> + SSL when (SSL =:= ssl) orelse (SSL =:= essl) -> SSLTag = if (SSL =:= ssl) -> diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index cb036157a5..4d0defb329 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -34,8 +34,7 @@ ftp_sup, %% HTTP client: - http, %% Old client API module - httpc, %% New client API module + httpc, httpc_handler, httpc_handler_sup, httpc_manager, diff --git a/lib/inets/src/inets_app/inets.appup.src b/lib/inets/src/inets_app/inets.appup.src index 8b0fcb185d..65cee34cb3 100644 --- a/lib/inets/src/inets_app/inets.appup.src +++ b/lib/inets/src/inets_app/inets.appup.src @@ -18,65 +18,27 @@ {"%VSN%", [ - {"5.6", - [ - {load_module, httpc, soft_purge, soft_purge, [httpc_manager]}, - {load_module, http_transport, soft_purge, soft_purge, [http_transport]}, - {update, httpc_handler, soft, soft_purge, soft_purge, []}, - {update, httpc_manager, soft, soft_purge, soft_purge, [httpc_handler]}, - {update, ftp, soft, soft_purge, soft_purge, []} - ] - }, - {"5.5.2", + {"5.7", [ {restart_application, inets} ] }, - {"5.5.1", - [ - {restart_application, inets} - ] - }, - {"5.5", - [ - {restart_application, inets} - ] - }, - {"5.4", + {"5.6", [ {restart_application, inets} ] } ], [ - {"5.6", - [ - {load_module, httpc, soft_purge, soft_purge, [httpc_manager]}, - {load_module, http_transport, soft_purge, soft_purge, [http_transport]}, - {update, httpc_handler, soft, soft_purge, soft_purge, []}, - {update, httpc_manager, soft, soft_purge, soft_purge, [httpc_handler]}, - {update, ftp, soft, soft_purge, soft_purge, []} - ] - }, - {"5.5.2", - [ - {restart_application, inets} - ] - }, - {"5.5.1", + {"5.7", [ {restart_application, inets} ] }, - {"5.5", - [ - {restart_application, inets} - ] - }, - {"5.4", + {"5.6", [ {restart_application, inets} ] - } + } ] }. diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 6edd5371af..f95fb93669 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -113,13 +113,10 @@ groups() -> proxy_page_does_not_exist, proxy_https_not_supported]}, {ssl, [], [ssl_head, - ossl_head, essl_head, ssl_get, - ossl_get, essl_get, ssl_trace, - ossl_trace, essl_trace]}, {stream, [], [http_stream, http_stream_once, @@ -273,10 +270,6 @@ init_per_testcase(Case, Timeout, Config) -> init_per_testcase_ssl(ssl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); - [$o, $s, $s, $l | _] -> - init_per_testcase_ssl(ossl, PrivDir, SslConfFile, - [{watchdog, Dog} | TmpConfig]); - [$e, $s, $s, $l | _] -> init_per_testcase_ssl(essl, PrivDir, SslConfFile, [{watchdog, Dog} | TmpConfig]); @@ -1076,13 +1069,6 @@ ssl_head(suite) -> ssl_head(Config) when is_list(Config) -> ssl_head(ssl, Config). -ossl_head(doc) -> - ["Same as http_head/1 but over ssl sockets."]; -ossl_head(suite) -> - []; -ossl_head(Config) when is_list(Config) -> - ssl_head(ossl, Config). - essl_head(doc) -> ["Same as http_head/1 but over ssl sockets."]; essl_head(suite) -> @@ -1105,8 +1091,6 @@ ssl_head(SslTag, Config) -> case SslTag of ssl -> SSLOptions; - ossl -> - {ossl, SSLOptions}; essl -> {essl, SSLOptions} end, @@ -1131,13 +1115,6 @@ ssl_get(suite) -> ssl_get(Config) when is_list(Config) -> ssl_get(ssl, Config). -ossl_get(doc) -> - ["Same as http_get/1 but over ssl sockets."]; -ossl_get(suite) -> - []; -ossl_get(Config) when is_list(Config) -> - ssl_get(ossl, Config). - essl_get(doc) -> ["Same as http_get/1 but over ssl sockets."]; essl_get(suite) -> @@ -1157,8 +1134,6 @@ ssl_get(SslTag, Config) when is_list(Config) -> case SslTag of ssl -> SSLOptions; - ossl -> - {ossl, SSLOptions}; essl -> {essl, SSLOptions} end, @@ -1184,13 +1159,6 @@ ssl_trace(suite) -> ssl_trace(Config) when is_list(Config) -> ssl_trace(ssl, Config). -ossl_trace(doc) -> - ["Same as http_trace/1 but over ssl sockets."]; -ossl_trace(suite) -> - []; -ossl_trace(Config) when is_list(Config) -> - ssl_trace(ossl, Config). - essl_trace(doc) -> ["Same as http_trace/1 but over ssl sockets."]; essl_trace(suite) -> @@ -1210,8 +1178,6 @@ ssl_trace(SslTag, Config) when is_list(Config) -> case SslTag of ssl -> SSLOptions; - ossl -> - {ossl, SSLOptions}; essl -> {essl, SSLOptions} end, @@ -3038,10 +3004,6 @@ dummy_server_init(Caller, essl, IpV, SSLOptions) -> BaseOpts = [{ssl_imp, new}, {backlog, 128}, binary, {reuseaddr,true}, {active, false} | SSLOptions], - dummy_ssl_server_init(Caller, BaseOpts, IpV); -dummy_server_init(Caller, ossl, IpV, SSLOptions) -> - BaseOpts = [{ssl_imp, old}, - {backlog, 128}, binary, {active, false} | SSLOptions], dummy_ssl_server_init(Caller, BaseOpts, IpV). dummy_ssl_server_init(Caller, BaseOpts, IpV) -> diff --git a/lib/inets/test/httpc_cookie_SUITE.erl b/lib/inets/test/httpc_cookie_SUITE.erl index feef5f1eea..ba50a42633 100644 --- a/lib/inets/test/httpc_cookie_SUITE.erl +++ b/lib/inets/test/httpc_cookie_SUITE.erl @@ -55,7 +55,7 @@ init_per_testcase(session_cookies_only = Case, Config0) -> "~n Config0: ~p", [Case, Config0]), Config = init_workdir(Case, Config0), application:start(inets), - http:set_options([{cookies, verify}]), + httpc:set_options([{cookies, verify}]), watch_dog(Config); init_per_testcase(Case, Config0) -> @@ -66,7 +66,7 @@ init_per_testcase(Case, Config0) -> application:load(inets), application:set_env(inets, services, [{httpc, {default, CaseDir}}]), application:start(inets), - http:set_options([{cookies, verify}]), + httpc:set_options([{cookies, verify}]), watch_dog(Config). watch_dog(Config) -> @@ -152,12 +152,12 @@ session_cookies_only(Config) when is_list(Config) -> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" ";max-age=60000"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} - = http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), application:stop(inets), application:start(inets), - {"cookie",""} = http:cookie_header(?URL), + {"cookie", ""} = httpc:cookie_header(?URL), tsp("session_cookies_only -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -172,9 +172,9 @@ netscape_cookies(Config) when is_list(Config) -> Expires = future_netscape_date(), SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/; " "expires=" ++ Expires}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} = - http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), tsp("netscape_cookies -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -189,13 +189,13 @@ cookie_cancel(Config) when is_list(Config) -> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" "max-age=60000"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} - = http:cookie_header(?URL), - NewSetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" - "max-age=0"}], - http:verify_cookies(NewSetCookieHeaders, ?URL), - {"cookie", ""} = http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), + NewSetCookieHeaders = + [{"set-cookie", "test_cookie=true; path=/;max-age=0"}], + httpc:store_cookies(NewSetCookieHeaders, ?URL), + {"cookie", ""} = httpc:cookie_header(?URL), tsp("cookie_cancel -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -209,11 +209,11 @@ cookie_expires(Config) when is_list(Config) -> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" "max-age=5"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} - = http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), test_server:sleep(10000), - {"cookie", ""} = http:cookie_header(?URL), + {"cookie", ""} = httpc:cookie_header(?URL), tsp("cookie_expires -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -227,16 +227,16 @@ persistent_cookie(Config) when is_list(Config)-> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" "max-age=60000"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=0; test_cookie=true; $Path=/"} = - http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie", "$Version=0; test_cookie=true; $Path=/"} = + httpc:cookie_header(?URL), CaseDir = ?config(case_top_dir, Config), application:stop(inets), application:load(inets), application:set_env(inets, services, [{httpc, {default, CaseDir}}]), application:start(inets), - http:set_options([{cookies, enabled}]), - {"cookie","$Version=0; test_cookie=true; $Path=/"} = http:cookie_header(?URL), + httpc:set_options([{cookies, enabled}]), + {"cookie","$Version=0; test_cookie=true; $Path=/"} = httpc:cookie_header(?URL), tsp("persistent_cookie -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -251,10 +251,10 @@ domain_cookie(Config) when is_list(Config) -> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/;" "domain=.cookie.test.org"}], - http:verify_cookies(SetCookieHeaders, ?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), {"cookie","$Version=0; test_cookie=true; $Path=/; " "$Domain=.cookie.test.org"} = - http:cookie_header(?URL_DOMAIN), + httpc:cookie_header(?URL_DOMAIN), tsp("domain_cookie -> Cookies 2: ~p", [httpc:which_cookies()]), ok. @@ -275,8 +275,8 @@ secure_cookie(Config) when is_list(Config) -> tsp("secure_cookie -> Cookies 1: ~p", [httpc:which_cookies()]), SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/; secure"}], - tsp("secure_cookie -> verify cookies (1)"), - ok = http:verify_cookies(SetCookieHeaders, ?URL), + tsp("secure_cookie -> store cookies (1)"), + ok = httpc:store_cookies(SetCookieHeaders, ?URL), tsp("secure_cookie -> Cookies 2: ~p", [httpc:which_cookies()]), @@ -286,9 +286,9 @@ secure_cookie(Config) when is_list(Config) -> tsp("secure_cookie -> check cookie (plain)"), check_cookie("", ?URL), - tsp("secure_cookie -> verify cookies (2)"), + tsp("secure_cookie -> store cookies (2)"), SetCookieHeaders1 = [{"set-cookie", "test1_cookie=true; path=/; secure"}], - ok = http:verify_cookies(SetCookieHeaders1, ?URL), + ok = httpc:store_cookies(SetCookieHeaders1, ?URL), tsp("secure_cookie -> Cookies 3: ~p", [httpc:which_cookies()]), @@ -297,7 +297,7 @@ secure_cookie(Config) when is_list(Config) -> "test1_cookie=true; $Path=/", ?URL_SECURE), %% {"cookie","$Version=0; test_cookie=true; $Path=/; " -%% "test1_cookie=true; $Path=/"} = http:cookie_header(?URL_SECURE), +%% "test1_cookie=true; $Path=/"} = httpc:cookie_header(?URL_SECURE), tsp("secure_cookie -> Cookies 4: ~p", [httpc:which_cookies()]), @@ -314,14 +314,14 @@ update_cookie(Config) when is_list(Config)-> "max-age=6500"}, {"set-cookie", "test_cookie2=true; path=/;" "max-age=6500"}], - http:verify_cookies(SetCookieHeaders, ?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), {"cookie", "$Version=0; test_cookie2=true; $Path=/; " - "test_cookie=true; $Path=/"} = http:cookie_header(?URL), + "test_cookie=true; $Path=/"} = httpc:cookie_header(?URL), NewSetCookieHeaders = [{"set-cookie", "test_cookie=false; " "path=/;max-age=6500"}], - http:verify_cookies(NewSetCookieHeaders, ?URL), + httpc:store_cookies(NewSetCookieHeaders, ?URL), {"cookie", "$Version=0; test_cookie2=true; $Path=/; " - "test_cookie=false; $Path=/"} = http:cookie_header(?URL). + "test_cookie=false; $Path=/"} = httpc:cookie_header(?URL). update_cookie_session(doc)-> ["Test that a cookie can be updated."]; @@ -330,13 +330,13 @@ update_cookie_session(suite) -> update_cookie_session(Config) when is_list(Config)-> SetCookieHeaders = [{"set-cookie", "test_cookie=true; path=/"}, {"set-cookie", "test_cookie2=true; path=/"}], - http:verify_cookies(SetCookieHeaders, ?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), {"cookie", "$Version=0; test_cookie2=true; $Path=/; " - "test_cookie=true; $Path=/"} = http:cookie_header(?URL), + "test_cookie=true; $Path=/"} = httpc:cookie_header(?URL), NewSetCookieHeaders = [{"set-cookie", "test_cookie=false; path=/"}], - http:verify_cookies(NewSetCookieHeaders, ?URL), + httpc:store_cookies(NewSetCookieHeaders, ?URL), {"cookie", "$Version=0; test_cookie2=true; $Path=/; " - "test_cookie=false; $Path=/"} = http:cookie_header(?URL). + "test_cookie=false; $Path=/"} = httpc:cookie_header(?URL). cookie_attributes(doc) -> @@ -348,8 +348,8 @@ cookie_attributes(Config) when is_list(Config) -> "comment=foobar; "%% Comment "foo=bar;" %% Nonsense should be ignored "max-age=60000"}], - http:verify_cookies(SetCookieHeaders, ?URL), - {"cookie","$Version=1; test_cookie=true"} = http:cookie_header(?URL), + httpc:store_cookies(SetCookieHeaders, ?URL), + {"cookie","$Version=1; test_cookie=true"} = httpc:cookie_header(?URL), ok. @@ -358,7 +358,7 @@ cookie_attributes(Config) when is_list(Config) -> %%-------------------------------------------------------------------- check_cookie(Expect, URL) -> - case http:cookie_header(URL) of + case httpc:cookie_header(URL) of {"cookie", Expect} -> ok; {"cookie", Unexpected} -> diff --git a/lib/inets/test/httpd_SUITE.erl b/lib/inets/test/httpd_SUITE.erl index c4d4bf969b..ea704e509e 100644 --- a/lib/inets/test/httpd_SUITE.erl +++ b/lib/inets/test/httpd_SUITE.erl @@ -68,127 +68,96 @@ -export([ pssl_mod_alias/1, - ossl_mod_alias/1, essl_mod_alias/1, pssl_mod_actions/1, - ossl_mod_actions/1, essl_mod_actions/1, pssl_mod_security/1, - ossl_mod_security/1, essl_mod_security/1, pssl_mod_auth/1, - ossl_mod_auth/1, essl_mod_auth/1, pssl_mod_auth_api/1, - ossl_mod_auth_api/1, essl_mod_auth_api/1, pssl_mod_auth_mnesia_api/1, - ossl_mod_auth_mnesia_api/1, essl_mod_auth_mnesia_api/1, pssl_mod_htaccess/1, - ossl_mod_htaccess/1, essl_mod_htaccess/1, pssl_mod_cgi/1, - ossl_mod_cgi/1, essl_mod_cgi/1, pssl_mod_esi/1, - ossl_mod_esi/1, essl_mod_esi/1, pssl_mod_get/1, - ossl_mod_get/1, essl_mod_get/1, pssl_mod_head/1, - ossl_mod_head/1, essl_mod_head/1, pssl_mod_all/1, - ossl_mod_all/1, essl_mod_all/1, pssl_load_light/1, - ossl_load_light/1, essl_load_light/1, pssl_load_medium/1, - ossl_load_medium/1, essl_load_medium/1, pssl_load_heavy/1, - ossl_load_heavy/1, essl_load_heavy/1, pssl_dos_hostname/1, - ossl_dos_hostname/1, essl_dos_hostname/1, pssl_time_test/1, - ossl_time_test/1, essl_time_test/1, pssl_restart_no_block/1, - ossl_restart_no_block/1, essl_restart_no_block/1, pssl_restart_disturbing_block/1, - ossl_restart_disturbing_block/1, essl_restart_disturbing_block/1, pssl_restart_non_disturbing_block/1, - ossl_restart_non_disturbing_block/1, essl_restart_non_disturbing_block/1, pssl_block_disturbing_idle/1, - ossl_block_disturbing_idle/1, essl_block_disturbing_idle/1, pssl_block_non_disturbing_idle/1, - ossl_block_non_disturbing_idle/1, essl_block_non_disturbing_idle/1, pssl_block_503/1, - ossl_block_503/1, essl_block_503/1, pssl_block_disturbing_active/1, - ossl_block_disturbing_active/1, essl_block_disturbing_active/1, pssl_block_non_disturbing_active/1, - ossl_block_non_disturbing_active/1, essl_block_non_disturbing_active/1, pssl_block_disturbing_active_timeout_not_released/1, - ossl_block_disturbing_active_timeout_not_released/1, essl_block_disturbing_active_timeout_not_released/1, pssl_block_disturbing_active_timeout_released/1, - ossl_block_disturbing_active_timeout_released/1, essl_block_disturbing_active_timeout_released/1, pssl_block_non_disturbing_active_timeout_not_released/1, - ossl_block_non_disturbing_active_timeout_not_released/1, essl_block_non_disturbing_active_timeout_not_released/1, pssl_block_non_disturbing_active_timeout_released/1, - ossl_block_non_disturbing_active_timeout_released/1, essl_block_non_disturbing_active_timeout_released/1, pssl_block_disturbing_blocker_dies/1, - ossl_block_disturbing_blocker_dies/1, essl_block_disturbing_blocker_dies/1, pssl_block_non_disturbing_blocker_dies/1, - ossl_block_non_disturbing_blocker_dies/1, essl_block_non_disturbing_blocker_dies/1 ]). @@ -272,8 +241,7 @@ groups() -> ip_block_non_disturbing_active_timeout_released, ip_block_disturbing_blocker_dies, ip_block_non_disturbing_blocker_dies]}, - {ssl, [], - [{group, pssl}, {group, ossl}, {group, essl}]}, + {ssl, [], [{group, pssl}, {group, essl}]}, {pssl, [], [pssl_mod_alias, pssl_mod_actions, pssl_mod_security, pssl_mod_auth, pssl_mod_auth_api, @@ -293,25 +261,6 @@ groups() -> pssl_block_non_disturbing_active_timeout_released, pssl_block_disturbing_blocker_dies, pssl_block_non_disturbing_blocker_dies]}, - {ossl, [], - [ossl_mod_alias, ossl_mod_actions, ossl_mod_security, - ossl_mod_auth, ossl_mod_auth_api, - ossl_mod_auth_mnesia_api, ossl_mod_htaccess, - ossl_mod_cgi, ossl_mod_esi, ossl_mod_get, ossl_mod_head, - ossl_mod_all, ossl_load_light, ossl_load_medium, - ossl_load_heavy, ossl_dos_hostname, ossl_time_test, - ossl_restart_no_block, ossl_restart_disturbing_block, - ossl_restart_non_disturbing_block, - ossl_block_disturbing_idle, - ossl_block_non_disturbing_idle, ossl_block_503, - ossl_block_disturbing_active, - ossl_block_non_disturbing_active, - ossl_block_disturbing_active_timeout_not_released, - ossl_block_disturbing_active_timeout_released, - ossl_block_non_disturbing_active_timeout_not_released, - ossl_block_non_disturbing_active_timeout_released, - ossl_block_disturbing_blocker_dies, - ossl_block_non_disturbing_blocker_dies]}, {essl, [], [essl_mod_alias, essl_mod_actions, essl_mod_security, essl_mod_auth, essl_mod_auth_api, @@ -493,7 +442,6 @@ init_per_testcase2(Case, Config) -> [X, $s, $s, $l | _] -> case X of $p -> ssl; - $o -> ossl; $e -> essl end; _ -> @@ -636,7 +584,6 @@ init_per_testcase3(Case, Config) -> SslTag = case X of $p -> ssl; % plain - $o -> ossl; % OpenSSL based ssl $e -> essl % Erlang based ssl end, case inets_test_lib:start_http_server_ssl( @@ -653,7 +600,6 @@ init_per_testcase3(Case, Config) -> SslTag = case X of $p -> ssl; - $o -> ossl; $e -> essl end, case inets_test_lib:start_http_server_ssl( @@ -1158,13 +1104,6 @@ pssl_mod_alias(suite) -> pssl_mod_alias(Config) when is_list(Config) -> ssl_mod_alias(ssl, Config). -ossl_mod_alias(doc) -> - ["Module test: mod_alias - using new of configure old SSL"]; -ossl_mod_alias(suite) -> - []; -ossl_mod_alias(Config) when is_list(Config) -> - ssl_mod_alias(ossl, Config). - essl_mod_alias(doc) -> ["Module test: mod_alias - using new of configure new SSL"]; essl_mod_alias(suite) -> @@ -1188,13 +1127,6 @@ pssl_mod_actions(suite) -> pssl_mod_actions(Config) when is_list(Config) -> ssl_mod_actions(ssl, Config). -ossl_mod_actions(doc) -> - ["Module test: mod_actions - using new of configure old SSL"]; -ossl_mod_actions(suite) -> - []; -ossl_mod_actions(Config) when is_list(Config) -> - ssl_mod_actions(ossl, Config). - essl_mod_actions(doc) -> ["Module test: mod_actions - using new of configure new SSL"]; essl_mod_actions(suite) -> @@ -1220,13 +1152,6 @@ pssl_mod_security(suite) -> pssl_mod_security(Config) when is_list(Config) -> ssl_mod_security(ssl, Config). -ossl_mod_security(doc) -> - ["Module test: mod_security - using new of configure old SSL"]; -ossl_mod_security(suite) -> - []; -ossl_mod_security(Config) when is_list(Config) -> - ssl_mod_security(ossl, Config). - essl_mod_security(doc) -> ["Module test: mod_security - using new of configure new SSL"]; essl_mod_security(suite) -> @@ -1253,13 +1178,6 @@ pssl_mod_auth(suite) -> pssl_mod_auth(Config) when is_list(Config) -> ssl_mod_auth(ssl, Config). -ossl_mod_auth(doc) -> - ["Module test: mod_auth - using new of configure old SSL"]; -ossl_mod_auth(suite) -> - []; -ossl_mod_auth(Config) when is_list(Config) -> - ssl_mod_auth(ossl, Config). - essl_mod_auth(doc) -> ["Module test: mod_auth - using new of configure new SSL"]; essl_mod_auth(suite) -> @@ -1284,13 +1202,6 @@ pssl_mod_auth_api(suite) -> pssl_mod_auth_api(Config) when is_list(Config) -> ssl_mod_auth_api(ssl, Config). -ossl_mod_auth_api(doc) -> - ["Module test: mod_auth - using new of configure old SSL"]; -ossl_mod_auth_api(suite) -> - []; -ossl_mod_auth_api(Config) when is_list(Config) -> - ssl_mod_auth_api(ossl, Config). - essl_mod_auth_api(doc) -> ["Module test: mod_auth - using new of configure new SSL"]; essl_mod_auth_api(suite) -> @@ -1317,13 +1228,6 @@ pssl_mod_auth_mnesia_api(suite) -> pssl_mod_auth_mnesia_api(Config) when is_list(Config) -> ssl_mod_auth_mnesia_api(ssl, Config). -ossl_mod_auth_mnesia_api(doc) -> - ["Module test: mod_auth_mnesia_api - using new of configure old SSL"]; -ossl_mod_auth_mnesia_api(suite) -> - []; -ossl_mod_auth_mnesia_api(Config) when is_list(Config) -> - ssl_mod_auth_mnesia_api(ossl, Config). - essl_mod_auth_mnesia_api(doc) -> ["Module test: mod_auth_mnesia_api - using new of configure new SSL"]; essl_mod_auth_mnesia_api(suite) -> @@ -1348,13 +1252,6 @@ pssl_mod_htaccess(suite) -> pssl_mod_htaccess(Config) when is_list(Config) -> ssl_mod_htaccess(ssl, Config). -ossl_mod_htaccess(doc) -> - ["Module test: mod_htaccess - using new of configure old SSL"]; -ossl_mod_htaccess(suite) -> - []; -ossl_mod_htaccess(Config) when is_list(Config) -> - ssl_mod_htaccess(ossl, Config). - essl_mod_htaccess(doc) -> ["Module test: mod_htaccess - using new of configure new SSL"]; essl_mod_htaccess(suite) -> @@ -1379,13 +1276,6 @@ pssl_mod_cgi(suite) -> pssl_mod_cgi(Config) when is_list(Config) -> ssl_mod_cgi(ssl, Config). -ossl_mod_cgi(doc) -> - ["Module test: mod_cgi - using new of configure old SSL"]; -ossl_mod_cgi(suite) -> - []; -ossl_mod_cgi(Config) when is_list(Config) -> - ssl_mod_cgi(ossl, Config). - essl_mod_cgi(doc) -> ["Module test: mod_cgi - using new of configure new SSL"]; essl_mod_cgi(suite) -> @@ -1415,13 +1305,6 @@ pssl_mod_esi(suite) -> pssl_mod_esi(Config) when is_list(Config) -> ssl_mod_esi(ssl, Config). -ossl_mod_esi(doc) -> - ["Module test: mod_esi - using new of configure old SSL"]; -ossl_mod_esi(suite) -> - []; -ossl_mod_esi(Config) when is_list(Config) -> - ssl_mod_esi(ossl, Config). - essl_mod_esi(doc) -> ["Module test: mod_esi - using new of configure new SSL"]; essl_mod_esi(suite) -> @@ -1446,13 +1329,6 @@ pssl_mod_get(suite) -> pssl_mod_get(Config) when is_list(Config) -> ssl_mod_get(ssl, Config). -ossl_mod_get(doc) -> - ["Module test: mod_get - using new of configure old SSL"]; -ossl_mod_get(suite) -> - []; -ossl_mod_get(Config) when is_list(Config) -> - ssl_mod_get(ossl, Config). - essl_mod_get(doc) -> ["Module test: mod_get - using new of configure new SSL"]; essl_mod_get(suite) -> @@ -1477,13 +1353,6 @@ pssl_mod_head(suite) -> pssl_mod_head(Config) when is_list(Config) -> ssl_mod_head(ssl, Config). -ossl_mod_head(doc) -> - ["Module test: mod_head - using new of configure old SSL"]; -ossl_mod_head(suite) -> - []; -ossl_mod_head(Config) when is_list(Config) -> - ssl_mod_head(ossl, Config). - essl_mod_head(doc) -> ["Module test: mod_head - using new of configure new SSL"]; essl_mod_head(suite) -> @@ -1508,13 +1377,6 @@ pssl_mod_all(suite) -> pssl_mod_all(Config) when is_list(Config) -> ssl_mod_all(ssl, Config). -ossl_mod_all(doc) -> - ["All modules test - using new of configure old SSL"]; -ossl_mod_all(suite) -> - []; -ossl_mod_all(Config) when is_list(Config) -> - ssl_mod_all(ossl, Config). - essl_mod_all(doc) -> ["All modules test - using new of configure new SSL"]; essl_mod_all(suite) -> @@ -1539,13 +1401,6 @@ pssl_load_light(suite) -> pssl_load_light(Config) when is_list(Config) -> ssl_load_light(ssl, Config). -ossl_load_light(doc) -> - ["Test light load - using new of configure old SSL"]; -ossl_load_light(suite) -> - []; -ossl_load_light(Config) when is_list(Config) -> - ssl_load_light(ossl, Config). - essl_load_light(doc) -> ["Test light load - using new of configure new SSL"]; essl_load_light(suite) -> @@ -1571,13 +1426,6 @@ pssl_load_medium(suite) -> pssl_load_medium(Config) when is_list(Config) -> ssl_load_medium(ssl, Config). -ossl_load_medium(doc) -> - ["Test medium load - using new of configure old SSL"]; -ossl_load_medium(suite) -> - []; -ossl_load_medium(Config) when is_list(Config) -> - ssl_load_medium(ossl, Config). - essl_load_medium(doc) -> ["Test medium load - using new of configure new SSL"]; essl_load_medium(suite) -> @@ -1609,13 +1457,6 @@ pssl_load_heavy(suite) -> pssl_load_heavy(Config) when is_list(Config) -> ssl_load_heavy(ssl, Config). -ossl_load_heavy(doc) -> - ["Test heavy load - using new of configure old SSL"]; -ossl_load_heavy(suite) -> - []; -ossl_load_heavy(Config) when is_list(Config) -> - ssl_load_heavy(ossl, Config). - essl_load_heavy(doc) -> ["Test heavy load - using new of configure new SSL"]; essl_load_heavy(suite) -> @@ -1647,13 +1488,6 @@ pssl_dos_hostname(suite) -> pssl_dos_hostname(Config) when is_list(Config) -> ssl_dos_hostname(ssl, Config). -ossl_dos_hostname(doc) -> - ["Denial Of Service (DOS) attack test case - using new of configure old SSL"]; -ossl_dos_hostname(suite) -> - []; -ossl_dos_hostname(Config) when is_list(Config) -> - ssl_dos_hostname(ossl, Config). - essl_dos_hostname(doc) -> ["Denial Of Service (DOS) attack test case - using new of configure new SSL"]; essl_dos_hostname(suite) -> @@ -1679,13 +1513,6 @@ pssl_time_test(suite) -> pssl_time_test(Config) when is_list(Config) -> ssl_time_test(ssl, Config). -ossl_time_test(doc) -> - ["using new of configure old SSL"]; -ossl_time_test(suite) -> - []; -ossl_time_test(Config) when is_list(Config) -> - ssl_time_test(ossl, Config). - essl_time_test(doc) -> ["using new of configure new SSL"]; essl_time_test(suite) -> @@ -1725,14 +1552,6 @@ pssl_block_503(suite) -> pssl_block_503(Config) when is_list(Config) -> ssl_block_503(ssl, Config). -ossl_block_503(doc) -> - ["Check that you will receive status code 503 when the server" - " is blocked and 200 when its not blocked - using new of configure old SSL."]; -ossl_block_503(suite) -> - []; -ossl_block_503(Config) when is_list(Config) -> - ssl_block_503(ossl, Config). - essl_block_503(doc) -> ["Check that you will receive status code 503 when the server" " is blocked and 200 when its not blocked - using new of configure new SSL."]; @@ -1760,15 +1579,6 @@ pssl_block_disturbing_idle(suite) -> pssl_block_disturbing_idle(Config) when is_list(Config) -> ssl_block_disturbing_idle(ssl, Config). -ossl_block_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "distribing does not really make a difference in this case." - "Using new of configure old SSL"]; -ossl_block_disturbing_idle(suite) -> - []; -ossl_block_disturbing_idle(Config) when is_list(Config) -> - ssl_block_disturbing_idle(ossl, Config). - essl_block_disturbing_idle(doc) -> ["Check that you can block/unblock an idle server. The strategy " "distribing does not really make a difference in this case." @@ -1797,15 +1607,6 @@ pssl_block_non_disturbing_idle(suite) -> pssl_block_non_disturbing_idle(Config) when is_list(Config) -> ssl_block_non_disturbing_idle(ssl, Config). -ossl_block_non_disturbing_idle(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing does not really make a difference in this case." - "Using new of configure old SSL"]; -ossl_block_non_disturbing_idle(suite) -> - []; -ossl_block_non_disturbing_idle(Config) when is_list(Config) -> - ssl_block_non_disturbing_idle(ossl, Config). - essl_block_non_disturbing_idle(doc) -> ["Check that you can block/unblock an idle server. The strategy " "non distribing does not really make a difference in this case." @@ -1834,15 +1635,6 @@ pssl_block_disturbing_active(suite) -> pssl_block_disturbing_active(Config) when is_list(Config) -> ssl_block_disturbing_active(ssl, Config). -ossl_block_disturbing_active(doc) -> - ["Check that you can block/unblock an active server. The strategy " - "distribing means ongoing requests should be terminated." - "Using new of configure old SSL"]; -ossl_block_disturbing_active(suite) -> - []; -ossl_block_disturbing_active(Config) when is_list(Config) -> - ssl_block_disturbing_active(ossl, Config). - essl_block_disturbing_active(doc) -> ["Check that you can block/unblock an active server. The strategy " "distribing means ongoing requests should be terminated." @@ -1871,15 +1663,6 @@ pssl_block_non_disturbing_active(suite) -> pssl_block_non_disturbing_active(Config) when is_list(Config) -> ssl_block_non_disturbing_active(ssl, Config). -ossl_block_non_disturbing_active(doc) -> - ["Check that you can block/unblock an idle server. The strategy " - "non distribing means the ongoing requests should be compleated." - "Using new of configure old SSL"]; -ossl_block_non_disturbing_active(suite) -> - []; -ossl_block_non_disturbing_active(Config) when is_list(Config) -> - ssl_block_non_disturbing_active(ossl, Config). - essl_block_non_disturbing_active(doc) -> ["Check that you can block/unblock an idle server. The strategy " "non distribing means the ongoing requests should be compleated." @@ -1910,17 +1693,6 @@ pssl_block_disturbing_active_timeout_not_released(Config) when is_list(Config) -> ssl_block_disturbing_active_timeout_not_released(ssl, Config). -ossl_block_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be compleated" - "if the timeout does not occur." - "Using new of configure old SSL"]; -ossl_block_disturbing_active_timeout_not_released(suite) -> - []; -ossl_block_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - ssl_block_disturbing_active_timeout_not_released(ossl, Config). - essl_block_disturbing_active_timeout_not_released(doc) -> ["Check that you can block an active server. The strategy " "distribing means ongoing requests should be compleated" @@ -1954,17 +1726,6 @@ pssl_block_disturbing_active_timeout_released(Config) when is_list(Config) -> ssl_block_disturbing_active_timeout_released(ssl, Config). -ossl_block_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "distribing means ongoing requests should be terminated when" - "the timeout occurs." - "Using new of configure old SSL"]; -ossl_block_disturbing_active_timeout_released(suite) -> - []; -ossl_block_disturbing_active_timeout_released(Config) - when is_list(Config) -> - ssl_block_disturbing_active_timeout_released(ossl, Config). - essl_block_disturbing_active_timeout_released(doc) -> ["Check that you can block an active server. The strategy " "distribing means ongoing requests should be terminated when" @@ -1999,16 +1760,6 @@ pssl_block_non_disturbing_active_timeout_not_released(Config) when is_list(Config) -> ssl_block_non_disturbing_active_timeout_not_released(ssl, Config). -ossl_block_non_disturbing_active_timeout_not_released(doc) -> - ["Check that you can block an active server. The strategy " - "non non distribing means ongoing requests should be completed." - "Using new of configure old SSL"]; -ossl_block_non_disturbing_active_timeout_not_released(suite) -> - []; -ossl_block_non_disturbing_active_timeout_not_released(Config) - when is_list(Config) -> - ssl_block_non_disturbing_active_timeout_not_released(ossl, Config). - essl_block_non_disturbing_active_timeout_not_released(doc) -> ["Check that you can block an active server. The strategy " "non non distribing means ongoing requests should be completed." @@ -2043,17 +1794,6 @@ pssl_block_non_disturbing_active_timeout_released(Config) when is_list(Config) -> ssl_block_non_disturbing_active_timeout_released(ssl, Config). -ossl_block_non_disturbing_active_timeout_released(doc) -> - ["Check that you can block an active server. The strategy " - "non distribing means ongoing requests should be completed. " - "When the timeout occurs the block operation sohould be canceled." - "Using new of configure old SSL"]; -ossl_block_non_disturbing_active_timeout_released(suite) -> - []; -ossl_block_non_disturbing_active_timeout_released(Config) - when is_list(Config) -> - ssl_block_non_disturbing_active_timeout_released(ossl, Config). - essl_block_non_disturbing_active_timeout_released(doc) -> ["Check that you can block an active server. The strategy " "non distribing means ongoing requests should be completed. " @@ -2087,13 +1827,6 @@ pssl_block_disturbing_blocker_dies(suite) -> pssl_block_disturbing_blocker_dies(Config) when is_list(Config) -> ssl_block_disturbing_blocker_dies(ssl, Config). -ossl_block_disturbing_blocker_dies(doc) -> - ["using new of configure old SSL"]; -ossl_block_disturbing_blocker_dies(suite) -> - []; -ossl_block_disturbing_blocker_dies(Config) when is_list(Config) -> - ssl_block_disturbing_blocker_dies(ossl, Config). - essl_block_disturbing_blocker_dies(doc) -> ["using new of configure new SSL"]; essl_block_disturbing_blocker_dies(suite) -> @@ -2118,13 +1851,6 @@ pssl_block_non_disturbing_blocker_dies(suite) -> pssl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> ssl_block_non_disturbing_blocker_dies(ssl, Config). -ossl_block_non_disturbing_blocker_dies(doc) -> - ["using new of configure old SSL"]; -ossl_block_non_disturbing_blocker_dies(suite) -> - []; -ossl_block_non_disturbing_blocker_dies(Config) when is_list(Config) -> - ssl_block_non_disturbing_blocker_dies(ossl, Config). - essl_block_non_disturbing_blocker_dies(doc) -> ["using new of configure new SSL"]; essl_block_non_disturbing_blocker_dies(suite) -> @@ -2149,13 +1875,6 @@ pssl_restart_no_block(suite) -> pssl_restart_no_block(Config) when is_list(Config) -> ssl_restart_no_block(ssl, Config). -ossl_restart_no_block(doc) -> - ["using new of configure old SSL"]; -ossl_restart_no_block(suite) -> - []; -ossl_restart_no_block(Config) when is_list(Config) -> - ssl_restart_no_block(ossl, Config). - essl_restart_no_block(doc) -> ["using new of configure new SSL"]; essl_restart_no_block(suite) -> @@ -2180,13 +1899,6 @@ pssl_restart_disturbing_block(suite) -> pssl_restart_disturbing_block(Config) when is_list(Config) -> ssl_restart_disturbing_block(ssl, Config). -ossl_restart_disturbing_block(doc) -> - ["using new of configure old SSL"]; -ossl_restart_disturbing_block(suite) -> - []; -ossl_restart_disturbing_block(Config) when is_list(Config) -> - ssl_restart_disturbing_block(ossl, Config). - essl_restart_disturbing_block(doc) -> ["using new of configure new SSL"]; essl_restart_disturbing_block(suite) -> @@ -2244,13 +1956,6 @@ pssl_restart_non_disturbing_block(suite) -> pssl_restart_non_disturbing_block(Config) when is_list(Config) -> ssl_restart_non_disturbing_block(ssl, Config). -ossl_restart_non_disturbing_block(doc) -> - ["using new of configure old SSL"]; -ossl_restart_non_disturbing_block(suite) -> - []; -ossl_restart_non_disturbing_block(Config) when is_list(Config) -> - ssl_restart_non_disturbing_block(ossl, Config). - essl_restart_non_disturbing_block(doc) -> ["using new of configure new SSL"]; essl_restart_non_disturbing_block(suite) -> @@ -2646,7 +2351,6 @@ create_config(Config, Access, FileName) -> SSL = if (Type =:= ssl) orelse - (Type =:= ossl) orelse (Type =:= essl) -> [cline(["SSLCertificateFile ", filename:join(ServerRoot, "ssl/ssl_server.pem")]), @@ -3041,7 +2745,6 @@ create_ipv6_config(Config, FileName, Ipv6Address) -> SSL = if (SockType =:= ssl) orelse - (SockType =:= ossl) orelse (SockType =:= essl) -> [cline(["SSLCertificateFile ", filename:join(ServerRoot, "ssl/ssl_server.pem")]), diff --git a/lib/inets/test/httpd_time_test.erl b/lib/inets/test/httpd_time_test.erl index f39f9faff0..c54674be36 100644 --- a/lib/inets/test/httpd_time_test.erl +++ b/lib/inets/test/httpd_time_test.erl @@ -19,7 +19,7 @@ %% -module(httpd_time_test). --export([t/3, t1/2, t2/2, t3/2, t4/2]). +-export([t/3, t1/2, t2/2, t4/2]). -export([do/1, do/2, do/3, do/4, do/5]). @@ -45,10 +45,6 @@ t2(Host, Port) -> t(ssl, Host, Port). -t3(Host, Port) -> - t(ossl, Host, Port). - - t4(Host, Port) -> t(essl, Host, Port). diff --git a/lib/inets/test/inets_test_lib.erl b/lib/inets/test/inets_test_lib.erl index 2e19c41f16..ddb1a49394 100644 --- a/lib/inets/test/inets_test_lib.erl +++ b/lib/inets/test/inets_test_lib.erl @@ -340,9 +340,6 @@ connect_bin(SockType, Host, Port) -> connect_bin(ssl, Host, Port, Opts0) -> Opts = [binary, {packet,0} | Opts0], connect(ssl, Host, Port, Opts); -connect_bin(ossl, Host, Port, Opts0) -> - Opts = [{ssl_imp, old}, binary, {packet,0} | Opts0], - connect(ssl, Host, Port, Opts); connect_bin(essl, Host, Port, Opts0) -> Opts = [{ssl_imp, new}, binary, {packet,0}, {reuseaddr, true} | Opts0], connect(ssl, Host, Port, Opts); @@ -357,9 +354,6 @@ connect_byte(SockType, Host, Port) -> connect_byte(ssl, Host, Port, Opts0) -> Opts = [{packet,0} | Opts0], connect(ssl, Host, Port, Opts); -connect_byte(ossl, Host, Port, Opts0) -> - Opts = [{ssl_imp, old}, {packet,0} | Opts0], - connect(ssl, Host, Port, Opts); connect_byte(essl, Host, Port, Opts0) -> Opts = [{ssl_imp, new}, {packet,0} | Opts0], connect(ssl, Host, Port, Opts); @@ -421,8 +415,6 @@ connect(ip_comm, Host, Port, Opts) -> send(ssl, Socket, Data) -> ssl:send(Socket, Data); -send(ossl, Socket, Data) -> - ssl:send(Socket, Data); send(essl, Socket, Data) -> ssl:send(Socket, Data); send(ip_comm,Socket,Data) -> @@ -431,8 +423,6 @@ send(ip_comm,Socket,Data) -> close(ssl,Socket) -> catch ssl:close(Socket); -close(ossl,Socket) -> - catch ssl:close(Socket); close(essl,Socket) -> catch ssl:close(Socket); close(ip_comm,Socket) -> diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 4abc1733d3..1df4558e45 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -18,7 +18,7 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 5.7 +INETS_VSN = 5.8 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/jinterface/java_src/Makefile b/lib/jinterface/java_src/Makefile index 755ef46a8b..19f99831eb 100644 --- a/lib/jinterface/java_src/Makefile +++ b/lib/jinterface/java_src/Makefile @@ -29,9 +29,7 @@ VSN=$(JINTERFACE_VSN) # Common Macros # ---------------------------------------------------- -# call recursive make explicitly below -# due to separate makefiles for Ronja & OTP -# SUB_DIRECTORIES = com/ericsson/otp/erlang +SUB_DIRECTORIES = com/ericsson/otp/erlang SPECIAL_TARGETS = @@ -51,15 +49,5 @@ POM_SRC= $(POM_FILE).src $(POM_TARGET): $(POM_SRC) ../vsn.mk sed -e 's;%VSN%;$(VSN);' $< > $@ -# ---------------------------------------------------- -# Default Subdir Targets -# ---------------------------------------------------- - -.PHONY: debug opt instr release docs release_docs tests release_tests clean depend - -debug opt instr release docs release_docs tests release_tests clean depend: $(TARGET_FILES) - set -e; set -x; \ - case "$(MAKE)" in *clearmake*) tflag="-T";; *) tflag="";; esac; \ - if test -f com/ericsson/otp/erlang/ignore_config_record.inf; then xflag=$$tflag; fi; \ - (cd com/ericsson/otp/erlang && $(MAKE) -f Makefile.otp $$xflag $@) +include $(ERL_TOP)/make/otp_subdir.mk diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile.otp b/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile index d0ff9cda34..e772a2b0a5 100644 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile.otp +++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/Makefile @@ -96,7 +96,7 @@ docs: # include $(ERL_TOP)/make/otp_release_targets.mk release release_docs release_tests release_html: - $(MAKE) -f Makefile.otp $(MFLAGS) RELEASE_PATH=$(RELEASE_PATH) $(TARGET_MAKEFILE) $@_spec + $(MAKE) $(MFLAGS) RELEASE_PATH=$(RELEASE_PATH) $(TARGET_MAKEFILE) $@_spec release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/java_src/com/ericsson/otp/erlang diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/ignore_config_record.inf b/lib/jinterface/java_src/com/ericsson/otp/erlang/ignore_config_record.inf deleted file mode 100644 index 0a5053eba3..0000000000 --- a/lib/jinterface/java_src/com/ericsson/otp/erlang/ignore_config_record.inf +++ /dev/null @@ -1 +0,0 @@ -This file makes clearmake use the -T switch for this subdirectory diff --git a/lib/kernel/src/dist.hrl b/lib/kernel/include/dist.hrl index aea1ab81ba..aea1ab81ba 100644 --- a/lib/kernel/src/dist.hrl +++ b/lib/kernel/include/dist.hrl diff --git a/lib/kernel/src/dist_util.hrl b/lib/kernel/include/dist_util.hrl index f2b0598532..f2b0598532 100644 --- a/lib/kernel/src/dist_util.hrl +++ b/lib/kernel/include/dist_util.hrl diff --git a/lib/kernel/src/net_address.hrl b/lib/kernel/include/net_address.hrl index 5342076507..5342076507 100644 --- a/lib/kernel/src/net_address.hrl +++ b/lib/kernel/include/net_address.hrl diff --git a/lib/kernel/src/Makefile b/lib/kernel/src/Makefile index 9db6014a7d..02be6b5036 100644 --- a/lib/kernel/src/Makefile +++ b/lib/kernel/src/Makefile @@ -118,11 +118,14 @@ MODULES = \ user_sup \ wrap_log_reader -HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl +HRL_FILES= ../include/file.hrl ../include/inet.hrl ../include/inet_sctp.hrl \ + ../include/dist.hrl ../include/dist_util.hrl \ + ../include/net_address.hrl + INTERNAL_HRL_FILES= application_master.hrl disk_log.hrl \ - net_address.hrl inet_dns.hrl inet_res.hrl \ + inet_dns.hrl inet_res.hrl \ inet_boot.hrl inet_config.hrl inet_int.hrl \ - dist.hrl dist_util.hrl inet_dns_record_adts.hrl + inet_dns_record_adts.hrl ERL_FILES= $(MODULES:%=%.erl) @@ -215,7 +218,7 @@ $(EBIN)/code_server.beam: ../include/file.hrl $(EBIN)/disk_log.beam: disk_log.hrl $(EBIN)/disk_log_1.beam: disk_log.hrl ../include/file.hrl $(EBIN)/disk_log_server.beam: disk_log.hrl -$(EBIN)/dist_util.beam: dist_util.hrl dist.hrl +$(EBIN)/dist_util.beam: ../include/dist_util.hrl ../include/dist.hrl $(EBIN)/erl_boot_server.beam: inet_boot.hrl $(EBIN)/erl_epmd.beam: inet_int.hrl erl_epmd.hrl $(EBIN)/file.beam: ../include/file.hrl @@ -226,7 +229,7 @@ $(EBIN)/global.beam: ../../stdlib/include/ms_transform.hrl $(EBIN)/hipe_unified_loader.beam: ../../hipe/main/hipe.hrl hipe_ext_format.hrl $(EBIN)/inet.beam: ../include/inet.hrl inet_int.hrl ../include/inet_sctp.hrl $(EBIN)/inet6_tcp.beam: inet_int.hrl -$(EBIN)/inet6_tcp_dist.beam: net_address.hrl dist.hrl dist_util.hrl +$(EBIN)/inet6_tcp_dist.beam: ../include/net_address.hrl ../include/dist.hrl ../include/dist_util.hrl $(EBIN)/inet6_udp.beam: inet_int.hrl $(EBIN)/inet6_sctp.beam: inet_int.hrl $(EBIN)/inet_config.beam: inet_config.hrl ../include/inet.hrl @@ -237,10 +240,10 @@ $(EBIN)/inet_hosts.beam: ../include/inet.hrl $(EBIN)/inet_parse.beam: ../include/file.hrl $(EBIN)/inet_res.beam: ../include/inet.hrl inet_res.hrl inet_dns.hrl inet_int.hrl $(EBIN)/inet_tcp.beam: inet_int.hrl -$(EBIN)/inet_udp_dist.beam: net_address.hrl dist.hrl dist_util.hrl +$(EBIN)/inet_udp_dist.beam: ../include/net_address.hrl ../include/dist.hrl ../include/dist_util.hrl $(EBIN)/inet_udp.beam: inet_int.hrl $(EBIN)/inet_sctp.beam: inet_int.hrl ../include/inet_sctp.hrl -$(EBIN)/net_kernel.beam: net_address.hrl +$(EBIN)/net_kernel.beam: ../include/net_address.hrl $(EBIN)/os.beam: ../include/file.hrl $(EBIN)/ram_file.beam: ../include/file.hrl $(EBIN)/wrap_log_reader.beam: disk_log.hrl ../include/file.hrl diff --git a/lib/kernel/src/error_handler.erl b/lib/kernel/src/error_handler.erl index e1f99bf417..a67b11a888 100644 --- a/lib/kernel/src/error_handler.erl +++ b/lib/kernel/src/error_handler.erl @@ -88,12 +88,12 @@ int() -> int. -spec crash(atom(), [term()]) -> no_return(). crash(Fun, Args) -> - crash({Fun,Args}). + crash({Fun,Args,[]}). -spec crash(atom(), atom(), arity()) -> no_return(). crash(M, F, A) -> - crash({M,F,A}). + crash({M,F,A,[]}). -spec crash(tuple()) -> no_return(). @@ -101,7 +101,8 @@ crash(Tuple) -> try erlang:error(undef) catch error:undef -> - erlang:raise(error, undef, [Tuple|tl(erlang:get_stacktrace())]) + Stk = [Tuple|tl(erlang:get_stacktrace())], + erlang:raise(error, undef, Stk) end. %% If the code_server has not been started yet dynamic code loading @@ -127,7 +128,7 @@ ensure_loaded(Module) -> -spec stub_function(atom(), atom(), [_]) -> no_return(). stub_function(Mod, Func, Args) -> - exit({undef,[{Mod,Func,Args}]}). + exit({undef,[{Mod,Func,Args,[]}]}). check_inheritance(Module, Args) -> Attrs = erlang:get_module_info(Module, attributes), diff --git a/lib/kernel/src/file.erl b/lib/kernel/src/file.erl index 5e4e1b0ba8..706c60caaf 100644 --- a/lib/kernel/src/file.erl +++ b/lib/kernel/src/file.erl @@ -1163,7 +1163,7 @@ path_open_first([Path|Rest], Name, Mode, LastError) -> {error, _} = Error -> Error; FilePath -> - FileName = filename:join(FilePath, Name), + FileName = fname_join(FilePath, Name), case open(FileName, Mode) of {ok, Fd} -> {ok, Fd, FileName}; @@ -1176,6 +1176,11 @@ path_open_first([Path|Rest], Name, Mode, LastError) -> path_open_first([], _Name, _Mode, LastError) -> {error, LastError}. +fname_join(".", Name) -> + Name; +fname_join(Dir, Name) -> + filename:join(Dir, Name). + %%%----------------------------------------------------------------- %%% Utility functions. diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index 86cccebc29..c7d39dfd5d 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -986,9 +986,9 @@ purge_stacktrace(Config) when is_list(Config) -> error:function_clause -> ?line code:load_file(code_b_test), ?line case erlang:get_stacktrace() of - [{?MODULE,_,[a]}, - {code_b_test,call,2}, - {?MODULE,purge_stacktrace,1}|_] -> + [{?MODULE,_,[a],_}, + {code_b_test,call,2,_}, + {?MODULE,purge_stacktrace,1,_}|_] -> ?line false = code:purge(code_b_test), ?line [] = erlang:get_stacktrace() end @@ -998,8 +998,8 @@ purge_stacktrace(Config) when is_list(Config) -> error:function_clause -> ?line code:load_file(code_b_test), ?line case erlang:get_stacktrace() of - [{code_b_test,call,[nofun,2]}, - {?MODULE,purge_stacktrace,1}|_] -> + [{code_b_test,call,[nofun,2],_}, + {?MODULE,purge_stacktrace,1,_}|_] -> ?line false = code:purge(code_b_test), ?line [] = erlang:get_stacktrace() end @@ -1010,8 +1010,8 @@ purge_stacktrace(Config) when is_list(Config) -> error:badarg -> ?line code:load_file(code_b_test), ?line case erlang:get_stacktrace() of - [{code_b_test,call,Args}, - {?MODULE,purge_stacktrace,1}|_] -> + [{code_b_test,call,Args,_}, + {?MODULE,purge_stacktrace,1,_}|_] -> ?line false = code:purge(code_b_test), ?line [] = erlang:get_stacktrace() end @@ -1472,7 +1472,7 @@ do_on_load_error(ReturnValue) -> ?line ErrorPid ! ReturnValue, receive {'DOWN',Ref,process,_,Exit} -> - ?line {undef,[{on_load_error,main,[]}|_]} = Exit + ?line {undef,[{on_load_error,main,[],_}|_]} = Exit end. native_early_modules(suite) -> []; diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl index 4ad9c6923d..74bafe8935 100644 --- a/lib/kernel/test/zlib_SUITE.erl +++ b/lib/kernel/test/zlib_SUITE.erl @@ -42,8 +42,8 @@ end end()). --define(BARG, {'EXIT',{badarg,[{zlib,_,_}|_]}}). --define(DATA_ERROR, {'EXIT',{data_error,[{zlib,_,_}|_]}}). +-define(BARG, {'EXIT',{badarg,[{zlib,_,_,_}|_]}}). +-define(DATA_ERROR, {'EXIT',{data_error,[{zlib,_,_,_}|_]}}). init_per_testcase(_Func, Config) -> Dog = test_server:timetrap(test_server:seconds(60)), diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk index 8be265e79d..76c62ece67 100644 --- a/lib/kernel/vsn.mk +++ b/lib/kernel/vsn.mk @@ -1 +1 @@ -KERNEL_VSN = 2.14.5 +KERNEL_VSN = 2.15 diff --git a/lib/megaco/src/binary/depend.mk b/lib/megaco/src/binary/depend.mk index 5ec4977175..d12bd8bad0 100644 --- a/lib/megaco/src/binary/depend.mk +++ b/lib/megaco/src/binary/depend.mk @@ -83,17 +83,16 @@ PER_BIN_DRV_V3_FLAGS = $(ASN1_CT_OPTS) +optimize # --- Version 1 --- -$(BER_ASN1_V1_SPEC).erl $(BER_ASN1_V1_SPEC).hrl: \ +$(BER_ASN1_V1_SPEC).erl: \ $(BER_ASN1_V1_SPEC).set.asn \ $(ASN1_V1_SPEC).asn @echo "$(BER_ASN1_V1_SPEC):" $(ERLC) -bber $(BER_V1_FLAGS) $(BER_ASN1_V1_SPEC).set.asn $(EBIN)/$(BER_ASN1_V1_SPEC).$(EMULATOR): \ - $(BER_ASN1_V1_SPEC).erl \ - $(BER_ASN1_V1_SPEC).hrl + $(BER_ASN1_V1_SPEC).erl -$(BER_BIN_ASN1_V1_SPEC).erl $(BER_BIN_ASN1_V1_SPEC).hrl: \ +$(BER_BIN_ASN1_V1_SPEC).erl: \ $(BER_BIN_ASN1_V1_SPEC).set.asn \ $(BER_BIN_ASN1_V1_SPEC).asn1config \ $(ASN1_V1_SPEC).asn @@ -101,10 +100,9 @@ $(BER_BIN_ASN1_V1_SPEC).erl $(BER_BIN_ASN1_V1_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_V1_FLAGS) $(BER_BIN_ASN1_V1_SPEC).set.asn $(EBIN)/$(BER_BIN_ASN1_V1_SPEC).$(EMULATOR): \ - $(BER_BIN_ASN1_V1_SPEC).erl \ - $(BER_BIN_ASN1_V1_SPEC).hrl + $(BER_BIN_ASN1_V1_SPEC).erl -$(BER_BIN_DRV_ASN1_V1_SPEC).erl $(BER_BIN_DRV_ASN1_V1_SPEC).hrl: \ +$(BER_BIN_DRV_ASN1_V1_SPEC).erl: \ $(BER_BIN_DRV_ASN1_V1_SPEC).set.asn \ $(BER_BIN_DRV_ASN1_V1_SPEC).asn1config \ $(ASN1_V1_SPEC).asn @@ -112,53 +110,48 @@ $(BER_BIN_DRV_ASN1_V1_SPEC).erl $(BER_BIN_DRV_ASN1_V1_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_DRV_V1_FLAGS) $(BER_BIN_DRV_ASN1_V1_SPEC).set.asn $(EBIN)/$(BER_BIN_DRV_ASN1_V1_SPEC).$(EMULATOR): \ - $(BER_BIN_DRV_ASN1_V1_SPEC).erl \ - $(BER_BIN_DRV_ASN1_V1_SPEC).hrl + $(BER_BIN_DRV_ASN1_V1_SPEC).erl -$(PER_ASN1_V1_SPEC).erl $(PER_ASN1_V1_SPEC).hrl: \ +$(PER_ASN1_V1_SPEC).erl: \ $(PER_ASN1_V1_SPEC).set.asn \ $(ASN1_V1_SPEC).asn @echo "$(PER_ASN1_V1_SPEC):" $(ERLC) -bper $(PER_V1_FLAGS) $(PER_ASN1_V1_SPEC).set.asn $(EBIN)/$(PER_ASN1_V1_SPEC).$(EMULATOR): \ - $(PER_ASN1_V1_SPEC).erl \ - $(PER_ASN1_V1_SPEC).hrl + $(PER_ASN1_V1_SPEC).erl -$(PER_BIN_ASN1_V1_SPEC).erl $(PER_BIN_ASN1_V1_SPEC).hrl: \ +$(PER_BIN_ASN1_V1_SPEC).erl: \ $(PER_BIN_ASN1_V1_SPEC).set.asn \ $(ASN1_V1_SPEC).asn @echo "$(PER_BIN_ASN1_V1_SPEC):" $(ERLC) -bper_bin $(PER_BIN_V1_FLAGS) $(PER_BIN_ASN1_V1_SPEC).set.asn $(EBIN)/$(PER_BIN_ASN1_V1_SPEC).$(EMULATOR): \ - $(PER_BIN_ASN1_V1_SPEC).erl \ - $(PER_BIN_ASN1_V1_SPEC).hrl + $(PER_BIN_ASN1_V1_SPEC).erl -$(PER_BIN_DRV_ASN1_V1_SPEC).erl $(PER_BIN_DRV_ASN1_V1_SPEC).hrl: \ +$(PER_BIN_DRV_ASN1_V1_SPEC).erl: \ $(PER_BIN_DRV_ASN1_V1_SPEC).set.asn \ $(ASN1_V1_SPEC).asn @echo "$(PER_BIN_DRV_ASN1_V1_SPEC):" $(ERLC) -bper_bin $(PER_BIN_DRV_V1_FLAGS) $(PER_BIN_DRV_ASN1_V1_SPEC).set.asn $(EBIN)/$(PER_BIN_DRV_ASN1_V1_SPEC).$(EMULATOR): \ - $(PER_BIN_DRV_ASN1_V1_SPEC).erl \ - $(PER_BIN_DRV_ASN1_V1_SPEC).hrl + $(PER_BIN_DRV_ASN1_V1_SPEC).erl # --- Version 2 --- -$(BER_ASN1_V2_SPEC).erl $(BER_ASN1_V2_SPEC).hrl: \ +$(BER_ASN1_V2_SPEC).erl: \ $(BER_ASN1_V2_SPEC).set.asn \ $(ASN1_V2_SPEC).asn @echo "$(BER_ASN1_V2_SPEC):" $(ERLC) -bber $(BER_V2_FLAGS) $(BER_ASN1_V2_SPEC).set.asn $(EBIN)/$(BER_ASN1_V2_SPEC).$(EMULATOR): \ - $(BER_ASN1_V2_SPEC).erl \ - $(BER_ASN1_V2_SPEC).hrl + $(BER_ASN1_V2_SPEC).erl -$(BER_BIN_ASN1_V2_SPEC).erl $(BER_BIN_ASN1_V2_SPEC).hrl: \ +$(BER_BIN_ASN1_V2_SPEC).erl: \ $(BER_BIN_ASN1_V2_SPEC).set.asn \ $(BER_BIN_ASN1_V2_SPEC).asn1config \ $(ASN1_V2_SPEC).asn @@ -166,10 +159,9 @@ $(BER_BIN_ASN1_V2_SPEC).erl $(BER_BIN_ASN1_V2_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_V2_FLAGS) $(BER_BIN_ASN1_V2_SPEC).set.asn $(EBIN)/$(BER_BIN_ASN1_V2_SPEC).$(EMULATOR): \ - $(BER_BIN_ASN1_V2_SPEC).erl \ - $(BER_BIN_ASN1_V2_SPEC).hrl + $(BER_BIN_ASN1_V2_SPEC).erl -$(BER_BIN_DRV_ASN1_V2_SPEC).erl $(BER_BIN_DRV_ASN1_V2_SPEC).hrl: \ +$(BER_BIN_DRV_ASN1_V2_SPEC).erl: \ $(BER_BIN_DRV_ASN1_V2_SPEC).set.asn \ $(BER_BIN_DRV_ASN1_V2_SPEC).asn1config \ $(ASN1_V2_SPEC).asn @@ -177,55 +169,50 @@ $(BER_BIN_DRV_ASN1_V2_SPEC).erl $(BER_BIN_DRV_ASN1_V2_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_DRV_V2_FLAGS) $(BER_BIN_DRV_ASN1_V2_SPEC).set.asn $(EBIN)/$(BER_BIN_DRV_ASN1_V2_SPEC).$(EMULATOR): \ - $(BER_BIN_DRV_ASN1_V2_SPEC).erl \ - $(BER_BIN_DRV_ASN1_V2_SPEC).hrl + $(BER_BIN_DRV_ASN1_V2_SPEC).erl -$(PER_ASN1_V2_SPEC).erl $(PER_ASN1_V2_SPEC).hrl: \ +$(PER_ASN1_V2_SPEC).erl: \ $(PER_ASN1_V2_SPEC).set.asn \ $(ASN1_V2_SPEC).asn @echo "$(PER_ASN1_V2_SPEC):" $(ERLC) -bper $(PER_V2_FLAGS) $(PER_ASN1_V2_SPEC).set.asn $(EBIN)/$(PER_ASN1_V2_SPEC).$(EMULATOR): \ - $(PER_ASN1_V2_SPEC).erl \ - $(PER_ASN1_V2_SPEC).hrl + $(PER_ASN1_V2_SPEC).erl -$(PER_BIN_ASN1_V2_SPEC).erl $(PER_BIN_ASN1_V2_SPEC).hrl: \ +$(PER_BIN_ASN1_V2_SPEC).erl: \ $(PER_BIN_ASN1_V2_SPEC).set.asn \ $(ASN1_V2_SPEC).asn @echo "$(PER_BIN_ASN1_V2_SPEC):" $(ERLC) -bper_bin $(PER_BIN_V2_FLAGS) $(PER_BIN_ASN1_V2_SPEC).set.asn $(EBIN)/$(PER_BIN_ASN1_V2_SPEC).$(EMULATOR): \ - $(PER_BIN_ASN1_V2_SPEC).erl \ - $(PER_BIN_ASN1_V2_SPEC).hrl + $(PER_BIN_ASN1_V2_SPEC).erl -$(PER_BIN_DRV_ASN1_V2_SPEC).erl $(PER_BIN_DRV_ASN1_V2_SPEC).hrl: \ +$(PER_BIN_DRV_ASN1_V2_SPEC).erl: \ $(PER_BIN_DRV_ASN1_V2_SPEC).set.asn \ $(ASN1_V2_SPEC).asn @echo "$(PER_BIN_DRV_ASN1_V2_SPEC):" $(ERLC) -bper_bin $(PER_BIN_DRV_V2_FLAGS) $(PER_BIN_DRV_ASN1_V2_SPEC).set.asn $(EBIN)/$(PER_BIN_DRV_ASN1_V2_SPEC).$(EMULATOR): \ - $(PER_BIN_DRV_ASN1_V2_SPEC).erl \ - $(PER_BIN_DRV_ASN1_V2_SPEC).hrl + $(PER_BIN_DRV_ASN1_V2_SPEC).erl # --- Version 3 --- # -- (prev3a) -- -$(BER_ASN1_PREV3A_SPEC).erl $(BER_ASN1_PREV3A_SPEC).hrl: \ +$(BER_ASN1_PREV3A_SPEC).erl: \ $(BER_ASN1_PREV3A_SPEC).set.asn \ $(ASN1_PREV3A_SPEC).asn @echo "$(BER_ASN1_PREV3A_SPEC):" $(ERLC) -bber $(BER_PREV3A_FLAGS) $(BER_ASN1_PREV3A_SPEC).set.asn $(EBIN)/$(BER_ASN1_PREV3A_SPEC).$(EMULATOR): \ - $(BER_ASN1_PREV3A_SPEC).erl \ - $(BER_ASN1_PREV3A_SPEC).hrl + $(BER_ASN1_PREV3A_SPEC).erl -$(BER_BIN_ASN1_PREV3A_SPEC).erl $(BER_BIN_ASN1_PREV3A_SPEC).hrl: \ +$(BER_BIN_ASN1_PREV3A_SPEC).erl: \ $(BER_BIN_ASN1_PREV3A_SPEC).set.asn \ $(BER_BIN_ASN1_PREV3A_SPEC).asn1config \ $(ASN1_PREV3A_SPEC).asn @@ -233,10 +220,9 @@ $(BER_BIN_ASN1_PREV3A_SPEC).erl $(BER_BIN_ASN1_PREV3A_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_PREV3A_FLAGS) $(BER_BIN_ASN1_PREV3A_SPEC).set.asn $(EBIN)/$(BER_BIN_ASN1_PREV3A_SPEC).$(EMULATOR): \ - $(BER_BIN_ASN1_PREV3A_SPEC).erl \ - $(BER_BIN_ASN1_PREV3A_SPEC).hrl + $(BER_BIN_ASN1_PREV3A_SPEC).erl -$(BER_BIN_DRV_ASN1_PREV3A_SPEC).erl $(BER_BIN_DRV_ASN1_PREV3A_SPEC).hrl: \ +$(BER_BIN_DRV_ASN1_PREV3A_SPEC).erl: \ $(BER_BIN_DRV_ASN1_PREV3A_SPEC).set.asn \ $(BER_BIN_DRV_ASN1_PREV3A_SPEC).asn1config \ $(ASN1_PREV3A_SPEC).asn @@ -244,52 +230,47 @@ $(BER_BIN_DRV_ASN1_PREV3A_SPEC).erl $(BER_BIN_DRV_ASN1_PREV3A_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_DRV_PREV3A_FLAGS) $(BER_BIN_DRV_ASN1_PREV3A_SPEC).set.asn $(EBIN)/$(BER_BIN_DRV_ASN1_PREV3A_SPEC).$(EMULATOR): \ - $(BER_BIN_DRV_ASN1_PREV3A_SPEC).erl \ - $(BER_BIN_DRV_ASN1_PREV3A_SPEC).hrl + $(BER_BIN_DRV_ASN1_PREV3A_SPEC).erl -$(PER_ASN1_PREV3A_SPEC).erl $(PER_ASN1_PREV3A_SPEC).hrl: \ +$(PER_ASN1_PREV3A_SPEC).erl: \ $(PER_ASN1_PREV3A_SPEC).set.asn \ $(ASN1_PREV3A_SPEC).asn @echo "$(PER_ASN1_PREV3A_SPEC):" $(ERLC) -bper $(PER_PREV3A_FLAGS) $(PER_ASN1_PREV3A_SPEC).set.asn $(EBIN)/$(PER_ASN1_PREV3A_SPEC).$(EMULATOR): \ - $(PER_ASN1_PREV3A_SPEC).erl \ - $(PER_ASN1_PREV3A_SPEC).hrl + $(PER_ASN1_PREV3A_SPEC).erl -$(PER_BIN_ASN1_PREV3A_SPEC).erl $(PER_BIN_ASN1_PREV3A_SPEC).hrl: \ +$(PER_BIN_ASN1_PREV3A_SPEC).erl: \ $(PER_BIN_ASN1_PREV3A_SPEC).set.asn \ $(ASN1_PREV3A_SPEC).asn @echo "$(PER_BIN_ASN1_PREV3A_SPEC):" $(ERLC) -bper_bin $(PER_BIN_PREV3A_FLAGS) $(PER_BIN_ASN1_PREV3A_SPEC).set.asn $(EBIN)/$(PER_BIN_ASN1_PREV3A_SPEC).$(EMULATOR): \ - $(PER_BIN_ASN1_PREV3A_SPEC).erl \ - $(PER_BIN_ASN1_PREV3A_SPEC).hrl + $(PER_BIN_ASN1_PREV3A_SPEC).erl -$(PER_BIN_DRV_ASN1_PREV3A_SPEC).erl $(PER_BIN_DRV_ASN1_PREV3A_SPEC).hrl: \ +$(PER_BIN_DRV_ASN1_PREV3A_SPEC).erl: \ $(PER_BIN_DRV_ASN1_PREV3A_SPEC).set.asn \ $(ASN1_PREV3A_SPEC).asn @echo "$(PER_BIN_DRV_ASN1_PREV3A_SPEC):" $(ERLC) -bper_bin $(PER_BIN_DRV_PREV3A_FLAGS) $(PER_BIN_DRV_ASN1_PREV3A_SPEC).set.asn $(EBIN)/$(PER_BIN_DRV_ASN1_PREV3A_SPEC).$(EMULATOR): \ - $(PER_BIN_DRV_ASN1_PREV3A_SPEC).erl \ - $(PER_BIN_DRV_ASN1_PREV3A_SPEC).hrl + $(PER_BIN_DRV_ASN1_PREV3A_SPEC).erl # -- (prev3b) -- -$(BER_ASN1_PREV3B_SPEC).erl $(BER_ASN1_PREV3B_SPEC).hrl: \ +$(BER_ASN1_PREV3B_SPEC).erl: \ $(BER_ASN1_PREV3B_SPEC).set.asn \ $(ASN1_PREV3B_SPEC).asn @echo "$(BER_ASN1_PREV3B_SPEC):" $(ERLC) -bber $(BER_PREV3B_FLAGS) $(BER_ASN1_PREV3B_SPEC).set.asn $(EBIN)/$(BER_ASN1_PREV3B_SPEC).$(EMULATOR): \ - $(BER_ASN1_PREV3B_SPEC).erl \ - $(BER_ASN1_PREV3B_SPEC).hrl + $(BER_ASN1_PREV3B_SPEC).erl -$(BER_BIN_ASN1_PREV3B_SPEC).erl $(BER_BIN_ASN1_PREV3B_SPEC).hrl: \ +$(BER_BIN_ASN1_PREV3B_SPEC).erl: \ $(BER_BIN_ASN1_PREV3B_SPEC).set.asn \ $(BER_BIN_ASN1_PREV3B_SPEC).asn1config \ $(ASN1_PREV3B_SPEC).asn @@ -297,10 +278,9 @@ $(BER_BIN_ASN1_PREV3B_SPEC).erl $(BER_BIN_ASN1_PREV3B_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_PREV3B_FLAGS) $(BER_BIN_ASN1_PREV3B_SPEC).set.asn $(EBIN)/$(BER_BIN_ASN1_PREV3B_SPEC).$(EMULATOR): \ - $(BER_BIN_ASN1_PREV3B_SPEC).erl \ - $(BER_BIN_ASN1_PREV3B_SPEC).hrl + $(BER_BIN_ASN1_PREV3B_SPEC).erl -$(BER_BIN_DRV_ASN1_PREV3B_SPEC).erl $(BER_BIN_DRV_ASN1_PREV3B_SPEC).hrl: \ +$(BER_BIN_DRV_ASN1_PREV3B_SPEC).erl: \ $(BER_BIN_DRV_ASN1_PREV3B_SPEC).set.asn \ $(BER_BIN_DRV_ASN1_PREV3B_SPEC).asn1config \ $(ASN1_PREV3B_SPEC).asn @@ -308,53 +288,48 @@ $(BER_BIN_DRV_ASN1_PREV3B_SPEC).erl $(BER_BIN_DRV_ASN1_PREV3B_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_DRV_PREV3B_FLAGS) $(BER_BIN_DRV_ASN1_PREV3B_SPEC).set.asn $(EBIN)/$(BER_BIN_DRV_ASN1_PREV3B_SPEC).$(EMULATOR): \ - $(BER_BIN_DRV_ASN1_PREV3B_SPEC).erl \ - $(BER_BIN_DRV_ASN1_PREV3B_SPEC).hrl + $(BER_BIN_DRV_ASN1_PREV3B_SPEC).erl -$(PER_ASN1_PREV3B_SPEC).erl $(PER_ASN1_PREV3B_SPEC).hrl: \ +$(PER_ASN1_PREV3B_SPEC).erl: \ $(PER_ASN1_PREV3B_SPEC).set.asn \ $(ASN1_PREV3B_SPEC).asn @echo "$(PER_ASN1_PREV3B_SPEC):" $(ERLC) -bper $(PER_PREV3B_FLAGS) $(PER_ASN1_PREV3B_SPEC).set.asn $(EBIN)/$(PER_ASN1_PREV3B_SPEC).$(EMULATOR): \ - $(PER_ASN1_PREV3B_SPEC).erl \ - $(PER_ASN1_PREV3B_SPEC).hrl + $(PER_ASN1_PREV3B_SPEC).erl -$(PER_BIN_ASN1_PREV3B_SPEC).erl $(PER_BIN_ASN1_PREV3B_SPEC).hrl: \ +$(PER_BIN_ASN1_PREV3B_SPEC).erl: \ $(PER_BIN_ASN1_PREV3B_SPEC).set.asn \ $(ASN1_PREV3B_SPEC).asn @echo "$(PER_BIN_ASN1_PREV3B_SPEC):" $(ERLC) -bper_bin $(PER_BIN_PREV3B_FLAGS) $(PER_BIN_ASN1_PREV3B_SPEC).set.asn $(EBIN)/$(PER_BIN_ASN1_PREV3B_SPEC).$(EMULATOR): \ - $(PER_BIN_ASN1_PREV3B_SPEC).erl \ - $(PER_BIN_ASN1_PREV3B_SPEC).hrl + $(PER_BIN_ASN1_PREV3B_SPEC).erl -$(PER_BIN_DRV_ASN1_PREV3B_SPEC).erl $(PER_BIN_DRV_ASN1_PREV3B_SPEC).hrl: \ +$(PER_BIN_DRV_ASN1_PREV3B_SPEC).erl: \ $(PER_BIN_DRV_ASN1_PREV3B_SPEC).set.asn \ $(ASN1_PREV3B_SPEC).asn @echo "$(PER_BIN_DRV_ASN1_PREV3B_SPEC):" $(ERLC) -bper_bin $(PER_BIN_DRV_PREV3B_FLAGS) $(PER_BIN_DRV_ASN1_PREV3B_SPEC).set.asn $(EBIN)/$(PER_BIN_DRV_ASN1_PREV3B_SPEC).$(EMULATOR): \ - $(PER_BIN_DRV_ASN1_PREV3B_SPEC).erl \ - $(PER_BIN_DRV_ASN1_PREV3B_SPEC).hrl + $(PER_BIN_DRV_ASN1_PREV3B_SPEC).erl # -- (prev3c) -- -$(BER_ASN1_PREV3C_SPEC).erl $(BER_ASN1_PREV3C_SPEC).hrl: \ +$(BER_ASN1_PREV3C_SPEC).erl: \ $(BER_ASN1_PREV3C_SPEC).set.asn \ $(ASN1_PREV3C_SPEC).asn @echo "$(BER_ASN1_PREV3C_SPEC):" $(ERLC) -bber $(BER_PREV3C_FLAGS) $(BER_ASN1_PREV3C_SPEC).set.asn $(EBIN)/$(BER_ASN1_PREV3C_SPEC).$(EMULATOR): \ - $(BER_ASN1_PREV3C_SPEC).erl \ - $(BER_ASN1_PREV3C_SPEC).hrl + $(BER_ASN1_PREV3C_SPEC).erl -$(BER_BIN_ASN1_PREV3C_SPEC).erl $(BER_BIN_ASN1_PREV3C_SPEC).hrl: \ +$(BER_BIN_ASN1_PREV3C_SPEC).erl: \ $(BER_BIN_ASN1_PREV3C_SPEC).set.asn \ $(BER_BIN_ASN1_PREV3C_SPEC).asn1config \ $(ASN1_PREV3C_SPEC).asn @@ -362,10 +337,9 @@ $(BER_BIN_ASN1_PREV3C_SPEC).erl $(BER_BIN_ASN1_PREV3C_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_PREV3C_FLAGS) $(BER_BIN_ASN1_PREV3C_SPEC).set.asn $(EBIN)/$(BER_BIN_ASN1_PREV3C_SPEC).$(EMULATOR): \ - $(BER_BIN_ASN1_PREV3C_SPEC).erl \ - $(BER_BIN_ASN1_PREV3C_SPEC).hrl + $(BER_BIN_ASN1_PREV3C_SPEC).erl -$(BER_BIN_DRV_ASN1_PREV3C_SPEC).erl $(BER_BIN_DRV_ASN1_PREV3C_SPEC).hrl: \ +$(BER_BIN_DRV_ASN1_PREV3C_SPEC).erl: \ $(BER_BIN_DRV_ASN1_PREV3C_SPEC).set.asn \ $(BER_BIN_DRV_ASN1_PREV3C_SPEC).asn1config \ $(ASN1_PREV3C_SPEC).asn @@ -373,53 +347,48 @@ $(BER_BIN_DRV_ASN1_PREV3C_SPEC).erl $(BER_BIN_DRV_ASN1_PREV3C_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_DRV_PREV3C_FLAGS) $(BER_BIN_DRV_ASN1_PREV3C_SPEC).set.asn $(EBIN)/$(BER_BIN_DRV_ASN1_PREV3C_SPEC).$(EMULATOR): \ - $(BER_BIN_DRV_ASN1_PREV3C_SPEC).erl \ - $(BER_BIN_DRV_ASN1_PREV3C_SPEC).hrl + $(BER_BIN_DRV_ASN1_PREV3C_SPEC).erl -$(PER_ASN1_PREV3C_SPEC).erl $(PER_ASN1_PREV3C_SPEC).hrl: \ +$(PER_ASN1_PREV3C_SPEC).erl: \ $(PER_ASN1_PREV3C_SPEC).set.asn \ $(ASN1_PREV3C_SPEC).asn @echo "$(PER_ASN1_PREV3C_SPEC):" $(ERLC) -bper $(PER_PREV3C_FLAGS) $(PER_ASN1_PREV3C_SPEC).set.asn $(EBIN)/$(PER_ASN1_PREV3C_SPEC).$(EMULATOR): \ - $(PER_ASN1_PREV3C_SPEC).erl \ - $(PER_ASN1_PREV3C_SPEC).hrl + $(PER_ASN1_PREV3C_SPEC).erl -$(PER_BIN_ASN1_PREV3C_SPEC).erl $(PER_BIN_ASN1_PREV3C_SPEC).hrl: \ +$(PER_BIN_ASN1_PREV3C_SPEC).erl: \ $(PER_BIN_ASN1_PREV3C_SPEC).set.asn \ $(ASN1_PREV3C_SPEC).asn @echo "$(PER_BIN_ASN1_PREV3C_SPEC):" $(ERLC) -bper_bin $(PER_BIN_PREV3C_FLAGS) $(PER_BIN_ASN1_PREV3C_SPEC).set.asn $(EBIN)/$(PER_BIN_ASN1_PREV3C_SPEC).$(EMULATOR): \ - $(PER_BIN_ASN1_PREV3C_SPEC).erl \ - $(PER_BIN_ASN1_PREV3C_SPEC).hrl + $(PER_BIN_ASN1_PREV3C_SPEC).erl -$(PER_BIN_DRV_ASN1_PREV3C_SPEC).erl $(PER_BIN_DRV_ASN1_PREV3C_SPEC).hrl: \ +$(PER_BIN_DRV_ASN1_PREV3C_SPEC).erl: \ $(PER_BIN_DRV_ASN1_PREV3C_SPEC).set.asn \ $(ASN1_PREV3C_SPEC).asn @echo "$(PER_BIN_DRV_ASN1_PREV3C_SPEC):" $(ERLC) -bper_bin $(PER_BIN_DRV_PREV3C_FLAGS) $(PER_BIN_DRV_ASN1_PREV3C_SPEC).set.asn $(EBIN)/$(PER_BIN_DRV_ASN1_PREV3C_SPEC).$(EMULATOR): \ - $(PER_BIN_DRV_ASN1_PREV3C_SPEC).erl \ - $(PER_BIN_DRV_ASN1_PREV3C_SPEC).hrl + $(PER_BIN_DRV_ASN1_PREV3C_SPEC).erl # -- (v3) -- -$(BER_ASN1_V3_SPEC).erl $(BER_ASN1_V3_SPEC).hrl: \ +$(BER_ASN1_V3_SPEC).erl: \ $(BER_ASN1_V3_SPEC).set.asn \ $(ASN1_V3_SPEC).asn @echo "$(BER_ASN1_V3_SPEC):" $(ERLC) -bber $(BER_V3_FLAGS) $(BER_ASN1_V3_SPEC).set.asn $(EBIN)/$(BER_ASN1_V3_SPEC).$(EMULATOR): \ - $(BER_ASN1_V3_SPEC).erl \ - $(BER_ASN1_V3_SPEC).hrl + $(BER_ASN1_V3_SPEC).erl -$(BER_BIN_ASN1_V3_SPEC).erl $(BER_BIN_ASN1_V3_SPEC).hrl: \ +$(BER_BIN_ASN1_V3_SPEC).erl: \ $(BER_BIN_ASN1_V3_SPEC).set.asn \ $(BER_BIN_ASN1_V3_SPEC).asn1config \ $(ASN1_V3_SPEC).asn @@ -427,10 +396,9 @@ $(BER_BIN_ASN1_V3_SPEC).erl $(BER_BIN_ASN1_V3_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_V3_FLAGS) $(BER_BIN_ASN1_V3_SPEC).set.asn $(EBIN)/$(BER_BIN_ASN1_V3_SPEC).$(EMULATOR): \ - $(BER_BIN_ASN1_V3_SPEC).erl \ - $(BER_BIN_ASN1_V3_SPEC).hrl + $(BER_BIN_ASN1_V3_SPEC).erl -$(BER_BIN_DRV_ASN1_V3_SPEC).erl $(BER_BIN_DRV_ASN1_V3_SPEC).hrl: \ +$(BER_BIN_DRV_ASN1_V3_SPEC).erl: \ $(BER_BIN_DRV_ASN1_V3_SPEC).set.asn \ $(BER_BIN_DRV_ASN1_V3_SPEC).asn1config \ $(ASN1_V3_SPEC).asn @@ -438,38 +406,34 @@ $(BER_BIN_DRV_ASN1_V3_SPEC).erl $(BER_BIN_DRV_ASN1_V3_SPEC).hrl: \ $(ERLC) -bber_bin $(BER_BIN_DRV_V3_FLAGS) $(BER_BIN_DRV_ASN1_V3_SPEC).set.asn $(EBIN)/$(BER_BIN_DRV_ASN1_V3_SPEC).$(EMULATOR): \ - $(BER_BIN_DRV_ASN1_V3_SPEC).erl \ - $(BER_BIN_DRV_ASN1_V3_SPEC).hrl + $(BER_BIN_DRV_ASN1_V3_SPEC).erl -$(PER_ASN1_V3_SPEC).erl $(PER_ASN1_V3_SPEC).hrl: \ +$(PER_ASN1_V3_SPEC).erl: \ $(PER_ASN1_V3_SPEC).set.asn \ $(ASN1_V3_SPEC).asn @echo "$(PER_ASN1_V3_SPEC):" $(ERLC) -bper $(PER_V3_FLAGS) $(PER_ASN1_V3_SPEC).set.asn $(EBIN)/$(PER_ASN1_V3_SPEC).$(EMULATOR): \ - $(PER_ASN1_V3_SPEC).erl \ - $(PER_ASN1_V3_SPEC).hrl + $(PER_ASN1_V3_SPEC).erl -$(PER_BIN_ASN1_V3_SPEC).erl $(PER_BIN_ASN1_V3_SPEC).hrl: \ +$(PER_BIN_ASN1_V3_SPEC).erl: \ $(PER_BIN_ASN1_V3_SPEC).set.asn \ $(ASN1_V3_SPEC).asn @echo "$(PER_BIN_ASN1_V3_SPEC):" $(ERLC) -bper_bin $(PER_BIN_V3_FLAGS) $(PER_BIN_ASN1_V3_SPEC).set.asn $(EBIN)/$(PER_BIN_ASN1_V3_SPEC).$(EMULATOR): \ - $(PER_BIN_ASN1_V3_SPEC).erl \ - $(PER_BIN_ASN1_V3_SPEC).hrl + $(PER_BIN_ASN1_V3_SPEC).erl -$(PER_BIN_DRV_ASN1_V3_SPEC).erl $(PER_BIN_DRV_ASN1_V3_SPEC).hrl: \ +$(PER_BIN_DRV_ASN1_V3_SPEC).erl: \ $(PER_BIN_DRV_ASN1_V3_SPEC).set.asn \ $(ASN1_V3_SPEC).asn @echo "$(PER_BIN_DRV_ASN1_V3_SPEC):" $(ERLC) -bper_bin $(PER_BIN_DRV_V3_FLAGS) $(PER_BIN_DRV_ASN1_V3_SPEC).set.asn $(EBIN)/$(PER_BIN_DRV_ASN1_V3_SPEC).$(EMULATOR): \ - $(PER_BIN_DRV_ASN1_V3_SPEC).erl \ - $(PER_BIN_DRV_ASN1_V3_SPEC).hrl + $(PER_BIN_DRV_ASN1_V3_SPEC).erl # ------------- diff --git a/lib/megaco/src/flex/Makefile.in b/lib/megaco/src/flex/Makefile.in index 5af651d89b..2c46a673e4 100644 --- a/lib/megaco/src/flex/Makefile.in +++ b/lib/megaco/src/flex/Makefile.in @@ -391,7 +391,9 @@ $(STD_DRV).c: $(STD_DRV).flex $(MT_DRV).c: $(MT_DRV).flex $(LEX) $(MT_LEX_FLAGS) -P$* -o$@ $< -solibs: $(LIBDIR) $(OBJDIR) $(SOLIBS) +_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) + +solibs: $(SOLIBS) $(OBJDIR)/$(STD_DRV).o: $(STD_DRV).c @echo "compiling std driver:" @@ -411,10 +413,3 @@ $(LIBDIR)/$(STD_DRV).$(DED_EXT): $(OBJDIR)/$(STD_DRV).o $(LIBDIR)/$(MT_DRV).$(DED_EXT): $(OBJDIR)/$(MT_DRV).o @echo "linking multi-threaded driver:" $(LD) $(LDFLAGS) -o $@ $< - -$(LIBDIR): - -mkdir -p $(LIBDIR) - -$(OBJDIR): - -mkdir -p $(OBJDIR) - diff --git a/lib/mnesia/src/mnesia_lib.erl b/lib/mnesia/src/mnesia_lib.erl index e8b8c58c70..ae6631646c 100644 --- a/lib/mnesia/src/mnesia_lib.erl +++ b/lib/mnesia/src/mnesia_lib.erl @@ -413,7 +413,7 @@ pr_other(Var, Other) -> [self(), process_info(self(), registered_name), Var, Other, Why]), case Other of - {badarg, [{ets, lookup_element, _}|_]} -> + {badarg, [{ets, lookup_element, _, _}|_]} -> exit(Why); _ -> erlang:error(Why) diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index eb83168498..c4b22814a8 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -429,7 +429,7 @@ init_table(Tab, disc_only_copies, Fun, DetsInfo,Sender) -> {ErtsVer, DetsData} -> Res = (catch dets:is_compatible_bchunk_format(Tab, DetsData)), case Res of - {'EXIT',{undef,[{dets,_,_}|_]}} -> + {'EXIT',{undef,[{dets,_,_,_}|_]}} -> Sender ! {self(), {old_protocol, Tab}}, dets:init_table(Tab, Fun); %% Old dets version {'EXIT', What} -> diff --git a/lib/observer/doc/src/ttb.xml b/lib/observer/doc/src/ttb.xml index 2c80891925..4e63aecbf2 100644 --- a/lib/observer/doc/src/ttb.xml +++ b/lib/observer/doc/src/ttb.xml @@ -25,11 +25,12 @@ <title>ttb</title> <prepared>Siri hansen</prepared> + <prepared>Bartlomiej Puzon</prepared> <responsible></responsible> <docno>1</docno> <approved></approved> <checked></checked> - <date>2002-02-25</date> + <date>2010-08-13</date> <rev>PA1</rev> <file>ttb.sgml</file> </header> @@ -43,6 +44,35 @@ </description> <funcs> <func> + <name>start_trace(Nodes, Patterns, FlagSpec, Opts) -> Result</name> + <fsummary>Start a trace port on each given node.</fsummary> + <type> + <v>Result = see p/2</v> + <v>Nodes = see tracer/2</v> + <v>Patterns = [tuple()]</v> + <v>FlagSpec = {Procs, Flags}</v> + <v>Proc = see p/2</v> + <v>Flags = see p/2</v> + <v>Opts = see tracer/2</v> + </type> + <desc> + <p>This function is a shortcut allowing to start a trace with one command. Each + tuple in <c>Patterns</c> is converted to list which is in turn passed to + <c>ttb:tpl</c>. + The call:<code type="none"> +ttb:start_trace([Node, OtherNode], +[{mod, foo, []}, {mod, bar, 2}], +{all, call}, +[{file, File}, {handler,{fun myhandler/4, S}}])</code> + is equivalent to <code type="none"> +ttb:start_trace([Node, OtherNode], [{file, File}, {handler,{fun myhandler/4, S}}]), +ttb:tpl(mod, foo, []), +ttb:tpl(mod, bar, 2, []), +ttb:p(all, call)</code> + </p> + </desc> + </func> + <func> <name>tracer() -> Result</name> <fsummary>This is equivalent to tracer(node()).</fsummary> <desc> @@ -50,6 +80,17 @@ </desc> </func> <func> + <name>tracer(Shortcut) -> Result</name> + <fsummary>Handy shortcuts for common tracing settings</fsummary> + <type> + <v>Shortcut = shell | dbg</v> + </type> + <desc> + <p><c>shell</c> is equivalent to <c>tracer(node(),[{file, {local, "ttb"}}, shell])</c>.</p> + <p><c>dbg</c> is equivalent to <c>tracer(node(),[{shell, only}])</c>.</p> + </desc> + </func> + <func> <name>tracer(Nodes) -> Result</name> <fsummary>This is equivalent to tracer(Nodes,[]).</fsummary> <desc> @@ -62,14 +103,21 @@ <type> <v>Result = {ok, ActivatedNodes} | {error,Reason}</v> <v>Nodes = atom() | [atom()] | all | existing | new</v> - <v>Opts = [Opt]</v> - <v>Opt = {file,Client} | {handler, FormatHandler} | {process_info,PI}</v> + <v>Opts = Opt | [Opt]</v> + <v>Opt = {file,Client} | {handler, FormatHandler} | {process_info,PI} | + shell | {shell, ShellSpec} | {timer, TimerSpec} | {overload, {MSec, Module, Function}} + | {flush, MSec} | resume | {resume, FetchTimeout}</v> + <v>TimerSpec = MSec | {MSec, StopOpts}</v> + <v>MSec = FetchTimeout = integer()</v> + <v>Module = Function = atom() </v> + <v>StopOpts = see stop/2</v> <v>Client = File | {local, File}</v> <v>File = Filename | Wrap</v> <v>Filename = string()</v> <v>Wrap = {wrap,Filename} | {wrap,Filename,Size,Count}</v> <v>FormatHandler = See format/2</v> <v>PI = true | false </v> + <v>ShellSpec = true | false | only</v> </type> <desc> <p>This function starts a file trace port on all given nodes @@ -96,7 +144,70 @@ is the process' registered name its globally registered name, or its initial function. It is possible to turn off this functionality by setting <c>PI = false</c>. - </p> + </p> + <p>The <c>{shell, ShellSpec}</c> option indicates that the trace messages should + be printed on the console as they are received by the tracing + process. This implies <c>{local, File}</c> trace client. If the ShellSpec + is <c>only</c> (instead of <c>true</c>), no trace logs are stored. + </p> + <p>The <c>shell</c> option is a shortcut for <c>{shell, true}</c>.</p> + <p>The <c>timer</c> option indicates that the trace should be + automatically stopped after <c>MSec</c> milliseconds. <c>StopOpts</c> + are passed to <c>ttb:stop/2</c> command if specified (default is <c>[]</c>). + Note that the timing is approximate, as delays related to + network communication are always present. The timer starts after + <c>ttb:p/2</c> is issued, so you can set up your trace patterns before. + </p> + <p>The <c>overload</c> option allows to enable overload + checking on the nodes under trace. <c>Module:Function(check)</c> + is performed each <c>MSec</c> milliseconds. If the check returns + <c>true</c>, the tracing is disabled on a given node.<br/> + <c>Module:Function</c> should be able to handle at least three + atoms: <c>init</c>, <c>check</c> and <c>stop</c>. <c>init</c> and + <c>stop</c> give the user a possibility to initialize and clean + up the check environment.<br/> + When a node gets overloaded, it is not possible to issue <c>ttb:p</c> + nor any command from the <c>ttb:tp</c> family, as it would lead to + inconsistent tracing state (different trace specifications on + different node). + </p> + <p>The <c>flush</c> option periodically flushes all file trace + port clients (see <c>dbg:flush_trace_port/1</c>). When enabled, + the buffers are freed each <c>MSec</c> milliseconds. This option is + not allowed with <c>{file, {local, File}}</c> tracing. + </p> + <p><c>{resume, FetchTimeout}</c> enables the autoresume feature. + Whenever enabled, remote nodes try to reconnect to the controlling node + in case they were restarted. The feature requires <c>runtime_tools</c> + application to be started (so it has to be present in the <c>.boot</c> + scripts if the traced nodes run with embedded erlang). If this is + not possible, resume may be performed manually by starting + <c>runtime_tools</c> remotely using <c>rpc:call/4</c>.<br/> + <c>ttb</c> tries to fetch all logs from a reconnecting node before + reinitializing the trace. This has to finish within FetchTimeout milliseconds + or is aborted<br/> + By default, autostart information is stored in a file called + <c>ttb_autostart.bin</c> on each node. If this is not desired + (i.e. on diskless nodes), a custom module to handle autostart + information storage and retrieval can be provided by specifying + <c>ttb_autostart_module</c> environment variable for the <c>runtime_tools</c> + application. The module has to respond to the following API: + <taglist> + <tag><c>write_config(Data) -> ok</c></tag> + <item>Store the provided data for further retrieval. It is + important to realize that the data storage used must not + be affected by the node crash.</item> + <tag><c>read_config() -> {ok, Data} | {error, Error}</c></tag> + <item>Retrieve configuration stored with <c>write_config(Data)</c>.</item> + <tag><c>delete_config() -> ok</c></tag> + <item>Delete configuration stored with <c>write_config(Data)</c>. + Note that after this call any subsequent calls to <c>read_config</c> + must return <c>{error, Error}</c>. + </item> + </taglist> + </p> + <p>The <c>resume</c> option implies the default <c>FetchTimeout</c>, which is + 10 seconds</p> </desc> </func> <func> @@ -110,7 +221,7 @@ </type> <desc> <p>This function sets the given trace flags on the given - processes. + processes. The <c>timestamp</c> flag is always turned on. </p> <p>Please turn to the Reference manual for module <c>dbg</c> for details about the possible trace flags. The parameter @@ -119,6 +230,9 @@ registered names or process identifiers. If a registered name is given, the flags are set on processes with this name on all active nodes.</p> + <p>Issuing this command starts the timer for this trace if + <c>timer</c> option was specified with <c>tracer/2</c>. + </p> </desc> </func> <func> @@ -155,6 +269,18 @@ <tag><c>ctpg</c></tag> <item>Clear trace pattern on global function calls</item> </taglist> + <p>With <c>tp</c> and <c>tpl</c> one of match specification shortcuts + may be used (example: <c>ttb:tp(foo_module, caller)</c>). The shortcuts are: + <taglist> + <item><c>return</c> - for <c>[{'_',[],[{return_trace}]}]</c> + (report the return value)</item> + <item><c>caller</c> - for <c>[{'_',[],[{message,{caller}}]}]</c> + (report the calling function)</item> + <item><c>{codestr, Str}</c> - for <c>dbg:fun2ms/1</c> arguments + passed as strings (example: <c>"fun(_) -> return_trace() end"</c>) + </item> + </taglist> + </p> </desc> </func> <func> @@ -189,7 +315,7 @@ </desc> </func> <func> - <name>write_config(ConfigFile,Config,Opt) -> ok | {error,Reason}</name> + <name>write_config(ConfigFile,Config,Opts) -> ok | {error,Reason}</name> <fsummary>Creates a config file.</fsummary> <type> <v>ConfigFile = string()</v> @@ -197,7 +323,8 @@ <v>Mod = atom()</v> <v>Func = atom()</v> <v>Args = [term()]</v> - <v>Opt = [] | [append]</v> + <v>Opts = Opt | [Opt]</v> + <v>Opt = append</v> </type> <desc> <p>This function creates or extends a config file which can be @@ -213,9 +340,9 @@ should be a list of integers pointing out the entries to be stored. </p> - <p>If <c>Opt</c> is not given or if it is <c>[]</c>, + <p>If <c>Opts</c> is not given or if it is <c>[]</c>, <c>ConfigFile</c> is deleted and a new file is created. If - <c>Opt = [append]</c>, <c>ConfigFile</c> will not be deleted. + <c>Opts = [append]</c>, <c>ConfigFile</c> will not be deleted. The new information will be appended at the end of the file.</p> </desc> </func> @@ -226,7 +353,9 @@ <v>ConfigFile = string()</v> </type> <desc> - <p>Executes all entries in the given config file.</p> + <p>Executes all entries in the given config file. Note that the history + of the last trace is always available in the file named + <c>ttb_last_config</c>.</p> </desc> </func> <func> @@ -243,6 +372,9 @@ </p> <p>The content of a config file can be listed with <c>list_config/1</c>.</p> + <p> Note that the history + of the last trace is always available in the file named + <c>ttb_last_config</c>.</p> </desc> </func> <func> @@ -334,29 +466,51 @@ </desc> </func> <func> - <name>stop(Opts) -> stopped</name> + <name>stop(Opts) -> stopped | {stopped, Dir}</name> <fsummary>Stop tracing and fetch/format logs from all nodes</fsummary> <type> - <v>Opts = [Opt]</v> - <v>Opt = fetch | format</v> + <v>Opts = Opt | [Opt]</v> + <v>Opt = nofetch | {fetch_dir, Dir} | format | {format, FormatOpts} | return_fetch_dir</v> + <v>Dir = string()</v> + <v>FormatOpts = see format/2</v> </type> <desc> - <p>Stops tracing on all nodes. - </p> - <p>The <c>fetch</c> option indicates that trace logs shall be - collected from all nodes after tracing is stopped. This option - is useful if nodes on remote machines are traced. Logs and - trace information files are then sent to the trace control + <p>Stops tracing on all nodes. Logs and + trace information files are sent to the trace control node and stored in a directory named - <c>ttb_upload-Timestamp</c>, where <c>Timestamp</c> is on the + <c>ttb_upload_FileName-Timestamp</c>, where <c>Filename</c> is + the one provided with <c>{file, File}</c> during trace setup + and <c>Timestamp</c> is of the form <c>yyyymmdd-hhmmss</c>. Even logs from nodes on the same machine as the trace control node are moved to this directory. - </p> + The history list is saved to a file named <c>ttb_last_config</c> + for further reference (as it will be not longer accessible + through history and configuration management functions (like + <c>ttb:list_history/0</c>). + </p> + <p>The <c>nofetch</c> option indicates that trace logs shall not be + collected after tracing is stopped. + </p> + <p>The <c>{fetch, Dir}</c> option allows to specify the directory + to fetch the data to. If the directory already exists, an + error is thrown. + </p> <p>The <c>format</c> option indicates that the trace logs - shall be formatted after tracing is stopped. Note that this - option also implies the <c>fetch</c> option, i.e. logs are - collected in a new directory on the trace control node before - formatting. All logs in the directory will be merged.</p> + shall be formatted after tracing is stopped. All logs in the fetch directory will be merged. + You may use <c>{format, FormatOpts}</c> to pass additional + arguments to <c>format/2</c>.</p> + <p>The <c>return_fetch_dir</c> option indicates that the return value + should be <c>{stopped, Dir}</c> and not just <c>stopped</c>. + This implies <c>fetch</c>. + </p> + </desc> + </func> + <func> + <name>get_et_handler()</name> + <fsummary>Returns <c>et</c> handler.</fsummary> + <desc> + <p>The <c>et</c> handler returned by the function may be used with <c>format/2</c> + or <c>tracer/2</c>. Example: <c>ttb:format(Dir, [{handler, ttb:get_et_handler()}])</c>.</p> </desc> </func> <func> @@ -372,37 +526,40 @@ <type> <v>File = string() | [string()]</v> <d>This can be the name of a binary log, a list of such logs or the name of a directory containing one or more binary logs.</d> - <v>Options = [Opt]</v> - <v>Opt = {out,Out} | {handler,FormatHandler}</v> + <v>Options = Opt | [Opt]</v> + <v>Opt = {out,Out} | {handler,FormatHandler} | disable_sort</v> <v>Out = standard_io | string()</v> - <v>FormatHandler = {Function, InitialState} | et</v> + <v>FormatHandler = {Function, InitialState}</v> <v>Function = fun(Fd,Trace,TraceInfo,State) -> State</v> <v>Fd = standard_io | FileDescriptor</v> <d>This is the file descriptor of the destination file <c>Out</c></d> <v>Trace = tuple()</v> <d>This is the trace message. Please turn to the Reference manual for the <c>erlang</c>module for details.</d> <v>TraceInfo = [{Key,ValueList}]</v> - <d>This includes the keys <c>flags</c>, <c>client</c>and <c>node</c>, and if <c>handler</c>is given as option to the tracer function, this is also included. In addition all information written with the <c>write_trace_info/2</c>function is included. </d> + <d>This includes the keys <c>flags</c>, <c>client</c> and <c>node</c>, and if <c>handler</c> is given as option to the tracer function, this is also included. In addition all information written with the <c>write_trace_info/2</c>function is included. </d> </type> <desc> - <p>Reads the given binary trace log(s). If a directory or a - list of logs is given and the <c>timestamp</c> flag was set - during tracing, the trace messages from the different logs are - merged according to the timestamps. - </p> + <p>Reads the given binary trace log(s). The logs are processed + in the order of their timestamp as long as <c>disable_sort</c> + option is not given. + </p> <p>If <c>FormatHandler = {Function,InitialState}</c>, <c>Function</c> will be called for each trace message. If - <c>FormatHandler = et</c>, <c>et_viewer</c> in the <em>Event Tracer</em> application (<c>et</c>) is used for presenting the - trace log graphically. <c>ttb</c> provides a few different + <c>FormatHandler = get_et_handler()</c>, <c>et_viewer</c> in + the <em>Event Tracer</em> application (<c>et</c>) is used for presenting + the trace log graphically. <c>ttb</c> provides a few different filters which can be selected from the Filter menu in the <c>et_viewer</c>. If <c>FormatHandler</c> is not given, a default handler is used which presents each trace message as a line of text. </p> + <p>The state returned from each call of <c>Function</c> is passed to the next call, + even if next call is to format a message from another log file. + </p> <p>If <c>Out</c> is given, <c>FormatHandler</c> gets the - filedescriptor to <c>Out</c> as the first parameter. + file descriptor to <c>Out</c> as the first parameter. </p> - <p><c>Out</c> is ignored if <c>FormatHandler = et</c>. + <p><c>Out</c> is ignored if <c>et</c> format handler is used. </p> <p>Wrap logs can be formatted one by one or all in one go. To format one of the wrap logs in a set, give the exact name of diff --git a/lib/observer/doc/src/ttb_ug.xml b/lib/observer/doc/src/ttb_ug.xml index 44b7b08fd3..4f2b55a22a 100644 --- a/lib/observer/doc/src/ttb_ug.xml +++ b/lib/observer/doc/src/ttb_ug.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2002</year><year>2009</year> + <year>2002</year><year>2010</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -48,11 +48,13 @@ <item>Formatting of binary trace logs and merging of logs from multiple nodes.</item> </list> - <p>Even though the intention of the Trace Tool Builder is to serve - as a base for tailor made trace tools, it is of course possible - to use it directly from the erlang shell. The application only - allows the use of file port tracer, so if you would like would - like to use other types of trace clients you will be better off + <p>The intention of the Trace Tool Builder is to serve + as a base for tailor made trace tools, but you may use it directly + from the erlang shell (it may mimic <c>dbg</c> behaviour while + still providing useful additions like match specification shortcuts). + The application only + allows the use of file port tracer, so if you would like + to use other types of trace clients you will be better off using <c>dbg</c> directly instead.</p> </section> @@ -64,14 +66,15 @@ trace flags on the processes you want to trace with <c>ttb:p/2</c>. Then, when the tracing is completed, you must stop the tracer with <c>ttb:stop/0/1</c> and format the trace log with - <c>ttb:format/1/2</c>. + <c>ttb:format/1/2</c> (as long as there is anything to format, of + course). </p> - <p><c>ttb:tracer/0/1/2</c> opens a file trace port on each node - that shall be traced. All trace messages will be written to this - port and end up in a binary file (the binary trace log). + <p><c>ttb:tracer/0/1/2</c> opens a trace port on each node + that shall be traced. By default, trace messages are written + to binary files on remote nodes(the binary trace log). </p> - <p><c>ttb:p/2</c> specifies which processes that shall be - traced. Trace flags given in this call specifies what to trace on + <p><c>ttb:p/2</c> specifies which processes shall be + traced. Trace flags given in this call specify what to trace on each process. You can call this function several times if you like different trace flags to be set on different processes. </p> @@ -105,14 +108,15 @@ -export([f/0]). f() -> receive - From when pid(From) -> + From when is_pid(From) -> Now = erlang:now(), From ! {self(),Now} end. </code> <p>The following example shows the basic use of <c>ttb</c> from the erlang shell. Default options are used both for starting the - tracer and for formatting. This gives a trace log named - <c>Node-ttb</c>, where <c>Node</c> is the name of the node. The + tracer and for formatting (the custom fetch dir is however provided). + This gives a trace log named <c>Node-ttb</c> in the newly-created + directory, where <c>Node</c> is the name of the node. The default handler prints the formatted trace messages in the shell.</p> <code type="none"><![CDATA[ @@ -131,11 +135,11 @@ f() -> (tiger@durin)50> (tiger@durin)50> %% Here I set a trace pattern on erlang:now/0 (tiger@durin)50> %% The trace pattern is a simple match spec -(tiger@durin)50> %% generated by dbg:fun2ms/1. It indicates that -(tiger@durin)50> %% the return value shall be traced. -(tiger@durin)50> MS = dbg:fun2ms(fun(_) -> return_trace() end). -[{'_',[],[{return_trace}]}] -(tiger@durin)51> ttb:tp(erlang,now,MS). +(tiger@durin)50> %% indicating that the return value should be +(tiger@durin)50> %% traced. Refer to the reference_manual for +(tiger@durin)50> %% the full list of match spec shortcuts +(tiger@durin)50> %% available. +(tiger@durin)51> ttb:tp(erlang,now,return). {ok,[{matched,tiger@durin,1},{saved,1}]} (tiger@durin)52> (tiger@durin)52> %% I run my test (i.e. send a message to @@ -145,11 +149,11 @@ f() -> (tiger@durin)53> (tiger@durin)53> %% And then I have to stop ttb in order to flush (tiger@durin)53> %% the trace port buffer -(tiger@durin)53> ttb:stop(). -stopped +(tiger@durin)53> ttb:stop([return, {fetch_dir, "fetch"}]). +{stopped, "fetch"} (tiger@durin)54> (tiger@durin)54> %% Finally I format my trace log -(tiger@durin)54> ttb:format("tiger@durin-ttb"). +(tiger@durin)54> ttb:format("fetch"). ({<0.125.0>,{m,f,0},tiger@durin}) call erlang:now() ({<0.125.0>,{m,f,0},tiger@durin}) returned from erlang:now/0 -> {1031,133451,667611} @@ -166,11 +170,9 @@ ok ]]></code> -module(mydebug). -export([start/0,trc/1,stop/0,format/1]). -export([print/4]). - %% Include ms_transform.hrl so that I can use dbg:fun2ms/2 to %% generate match specifications. -include_lib("stdlib/include/ms_transform.hrl"). - %%% -------------Tool API------------- %%% ---------------------------------- %%% Star the "mydebug" tool @@ -180,28 +182,28 @@ start() -> %% module shall be used as format handler ttb:tracer(all,[{file,"debug_log"},{handler,{{?MODULE,print},0}}]), %% All processes (existing and new) shall trace function calls - %% and include a timestamp in each trace message - ttb:p(all,[call,timestamp]). + %% We want trace messages to be sorted upon format, which requires + %% timestamp flag. The flag is however enabled by default in ttb. + ttb:p(all,call). %%% Set trace pattern on function(s) -trc(M) when atom(M) -> +trc(M) when is_atom(M) -> trc({M,'_','_'}); -trc({M,F}) when atom(M), atom(F) -> +trc({M,F}) when is_atom(M), is_atom(F) -> trc({M,F,'_'}); -trc({M,F,_A}=MFA) when atom(M), atom(F) -> - %% This match spec specifies that return values shall - %% be traced. NOTE that ms_transform.hrl must be included - %% if dbg:fun2ms/1 shall be used! +trc({M,F,_A}=MFA) when is_atom(M), is_atom(F) -> + %% This match spec shortcut specifies that return values shall + %% be traced. MatchSpec = dbg:fun2ms(fun(_) -> return_trace() end), ttb:tpl(MFA,MatchSpec). %%% Format a binary trace log -format(File) -> - ttb:format(File). +format(Dir) -> + ttb:format(Dir). %%% Stop the "mydebug" tool stop() -> - ttb:stop(). + ttb:stop(return). %%% --------Internal functions-------- %%% ---------------------------------- @@ -226,9 +228,9 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> [N,Ts,P,M,F,A,R]). ]]></code> <p>To distinguish trace logs produced with this tool from other logs, the <c>file</c> option is used in <c>tracer/2</c>. The - logs will therefore be named <c>Node-debug_log</c>, where - <c>Node</c> is the name of the node where the log is produced. - </p> + logs will therefore be fetched to a directory named + <c>ttb_upload_debug_log-YYYYMMDD-HHMMSS</c> + </p> <p>By using the <c>handler</c> option when starting the tracer, the information about how to format the file is stored in the trace information file (<c>.ti</c>). This is not necessary, as @@ -278,13 +280,157 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> must be given to the <c>tracer/2</c> function with the value <c>{local, File}</c>, e.g.</p> <code type="none"> -(trace_control@durin)1> ttb:tracer(mynode@diskless,[{file,{local, -{wrap,"mytrace"}}}]). +(trace_control@durin)1> ttb:tracer(mynode@diskless,{file,{local, +{wrap,"mytrace"}}}). {ok,[mynode@diskless]} </code> </section> </section> <section> + <title>Additional tracing options</title> + <p>When setting up a trace, several features may be turned on:</p> + <list type="bulleted"> + <item>time-constrained tracing,</item> + <item>overload protection,</item> + <item>autoresuming.</item> + </list> + <section> + <title>Time-constrained tracing</title> + <p>Sometimes, it may be helpful to enable trace for a + given period of time (i.e. to monitor a system for 24 hours + or half of a second). This may be done by issuing additional + <c>{timer, TimerSpec}</c> option. If <c>TimerSpec</c> has the + form of <c>MSec</c>, the trace is stopped after <c>MSec</c> + milliseconds using <c>ttb:stop/0</c>. If any additional options + are provided (<c>TimerSpec = {MSec, Opts}</c>), <c>ttb:stop/1</c> + is called instead with <c>Opts</c> as the arguments. The timer + is started with <c>ttb:p/2</c>, so any trace patterns should + be set up before. <c>ttb:start_trace/4</c> + always sets up all pattern before invoking <c>ttb:p/2</c>. + Note that due to network and processing delays the the period + of tracing is approximate. + The example below shows how to set up a trace which will be + automatically stopped and formatted after 5 seconds + </p><code> +(tiger@durin)1>ttb:start_trace([node()], + [{erlang, now,[]}], + {all, call}, + [{timer, {5000, format}}]). +</code> + </section> + <section> + <label>Overload protection</label> + <p>When tracing live systems, special care needs to be always taken + not to overload a node with too heavy tracing. <c>ttb</c> provides + the <c>overload</c> option to help to address the problem.</p> + <p><c>{overload, MSec, Module, Function}</c> instructs the ttb backend + (called <c>observer_backend</c>, part of the <c>runtime_tools</c> + application) to perform overload check every <c>MSec</c> milliseconds. + If the check (namely <c>Module:Function(check)</c>) returns + <c>true</c>, tracing is disabled on the selected node.</p> + <p>Overload protection activated on one node does not + affect other nodes, where the tracing continues as normal. + <c>ttb:stop/0/1</c> fetches data from all clients, including everything + that has been collected before overload protection was activated. + Note that + changing trace details (with <c>ttb:p</c> and <c>ttb:tp/tpl...</c>) + once overload protection gets activated in one of the traced + nodes is not permitted in order not to allow trace setup + to be inconsistent between nodes. + </p> + <p><c>Module:Function</c> provided with the <c>overload</c> option must + handle three calls: <c>init</c>, <c>check</c> and <c>stop</c>. <c>init</c> + and <c>stop</c> allows to perform some setup and teardown required by + the check. An overload check module could look like this (note that + <c>check</c> is always called by the same process, so <c>put</c> and + <c>get</c> are possible). + </p><code> +-module(overload). +-export([check/1]). + +check(init) -> + Pid = sophisticated_module:start(), + put(pid, Pid); +check(check) -> + get(pid) ! is_overloaded, + receive + Reply -> + Reply + after 5000 -> + true + end; +check(stop) -> + get(pid) ! stop.</code> + </section> + <section> + <title>Autoresume</title> + <p>It is possible that a node (probably a buggy one, hence traced) + crashes. In order to automatically resume tracing on the node + as soon as it gets back, <c>resume</c> has to be used. When + it is, the failing node tries to reconnect + to trace control node as soon as <c>runtime tools</c> is started. + This implies that <c>runtime_tools</c> must be included in + other node's startup chain (if it is not, one could still + resume tracing by starting <c>runtime_tools</c> manually, + i.e. by an RPC call).</p> + <p>In order not to loose the data that the failing node stored + up to the point of crash, the control node will try to fetch + it before restarting trace. This must happen within the allowed + time frame or is aborted (default is 10 seconds, can be customized with + <c>{resume, MSec}</c>). The data fetched this way is then + merged with all other traces.</p> + <p>Autostart feature requires additional data to be stored on + traced nodes. By default, the data is stored automatically + to the file called "ttb_autostart.bin" in the traced node's cwd. + Users may decide to change this behaviour (i.e. on diskless + nodes) by specifying their own module to handle autostart data + storage and retrieval (<c>ttb_autostart_module</c> + environment variable of <c>runtime_tools</c>). Please see the + ttb's reference manual to see the module's API. This example + shows the default handler</p> + <code> +-module(ttb_autostart). +-export([read_config/0, + write_config/1, + delete_config/0]). + +-define(AUTOSTART_FILENAME, "ttb_autostart.bin"). + +delete_config() -> + file:delete(?AUTOSTART_FILENAME). + +read_config() -> + case file:read_file(?AUTOSTART_FILENAME) of + {ok, Data} -> {ok, binary_to_term(Data)}; + Error -> Error + end. + +write_config(Data) -> + file:write_file(?AUTOSTART_FILENAME, term_to_binary(Data)). + </code> + <p>Remember that file trace ports buffer the data + by default. If the node crashes, trace messages are not + flushed to the binary log. If the chance of failure is + high, it might be a good idea to automatically flush + the buffers every now and then. Passing <c>{flush, MSec}</c> + as one of <c>ttb:tracer/2</c> option flushes all buffers + every <c>MSec</c> milliseconds.</p> + </section> + <section> + <title>dbg mode</title> + <p>The <c>{shell, ShellType}</c> option allows to make <c>ttb</c> + operation similar to <c>dbg</c>. Using <c>{shell, true}</c> + displays all trace messages in the shell before storing them. + <c>{shell, only}</c> additionally disables message storage + (so that the tool behaves exactly like dbg). This is allowed + only with ip trace ports (<c>{trace, {local, File}}</c>). + </p> + <p>The command <c>ttb:tracer(dbg)</c> is a shortcut for the pure-dbg + mode (<c>{shell, only}</c>).</p> + </section> + </section> + + <section> <marker id="trace_info"></marker> <title>Trace Information and the .ti File</title> <p>In addition to the trace log file(s), a file with the extension @@ -292,13 +438,9 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> is the trace information file. It is a binary file, and it contains the process information, trace flags used, the name of the node to which it belongs and all information written with the - <c>write_trace_info/2</c> function. - </p> - <p>To be able to use all this information during formatting, it is - important that the trace information file exists in the same - directory as the trace log, and that it has the same name as the - trace log with the additional extension <c>.ti</c>. - </p> + <c>write_trace_info/2</c> function. .ti files are always fetched + with other logs when the trace is stopped. + </p> <p>Except for the process information, everything in the trace information file is passed on to the handler function when formatting. The <c>TI</c> parameter is a list of @@ -327,7 +469,12 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> each log. <c>ttb</c> will create a new binary log each time a log reaches the maximum size. When the the maximum number of logs are reached, the oldest log is deleted before a new one is created. - </p> + </p> + <p>Note that the overall size of data generated by ttb may be greater + than the wrap specification would suggest - if a traced node restarts + and autoresume is enabled, old wrap log is always stored and + a new one is created. + </p> <p>Wrap logs can be formatted one by one or all at once. See <seealso marker="#format">Formatting</seealso>. </p> @@ -348,12 +495,10 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> present the trace log graphically (see <seealso marker="#et_viewer">Presenting trace logs with Event Tracer</seealso>). </p> <p>The first argument to <c>ttb:format/1/2</c> specifies which - binary log(s) to format. This can be the name of one binary log, a - list of such logs or the name of a directory containing one or - more binary logs. If this argument indicates more than one log, - and the <c>timestamp</c> flag was set when tracing, the trace - messages from the different logs will be merged according to the - timestamps in each message. + binary log(s) to format. This is usually the name of a directory + that ttb created during log fetch. Unless there is the <c>disable_sort</c> + option provided, the logs from different files are always sorted + according to timestamp in traces. </p> <p>The second argument to <c>ttb:format/2</c> is a list of options. The <c>out</c> option specifies the destination where the @@ -363,7 +508,10 @@ do_print(Out,{trace_ts,P,return_from,{M,F,A},R,Ts},N) -> option is not given, the <c>handler</c> option given when starting the tracer is used. If the <c>handler</c> option was not given when starting the tracer either, a default handler is used, which - prints each trace message as a line of text. + prints each trace message as a line of text. The <c>disable_sort</c> + option indicates that there logs should not be merged according to + timestamp, but processed one file after another (this might be + a bit faster). </p> <p>A format handler is a fun taking four arguments. This fun will be called for each trace message in the binary log(s). A simple @@ -396,10 +544,24 @@ end </code> <c>handle_gc/4</c> in the module <c>multitrace.erl</c> which can be found in the <c>src</c> directory of the Observer application. </p> - <p>By giving the format handler <c>et</c>, you can have the trace + <p>The actual trace message is passed as the second argument (<c>Trace</c>). + The possible values of <c>Trace</c> are:</p> + <list type="bulleted"> + <item>all trace messages described in <c>erlang:trace/3</c> documentation, + </item> + <item><c>{drop, N}</c> if ip tracer is used (see <c>dbg:trace_port/2</c>), + </item> + <item><c>end_of_trace</c> received once when all trace messages have + been processed.</item> + </list> + <p>By giving the format handler <c>ttb:get_et_handler()</c>, you can have the trace log presented graphically with <c>et_viewer</c> in the Event Tracer application (see <seealso marker="#et_viewer">Presenting trace logs with Event Tracer</seealso>). - </p> + </p> + <p>You may always decide not to format the whole trace data contained + in the fetch directory, but analyze single files instead. In order + to do so, a single file (or list of files) have to be passed as + the first argument to <c>format/1/2</c>.</p> <p>Wrap logs can be formatted one by one or all in one go. To format one of the wrap logs in a set, give the exact name of the file. To format the whole set of wrap logs, give the name with '*' @@ -407,7 +569,7 @@ end </code> </p> <p>Start tracing:</p> <code type="none"> -(tiger@durin)1> ttb:tracer(node(),[{file,{wrap,"trace"}}]). +(tiger@durin)1> ttb:tracer(node(),{file,{wrap,"trace"}}). {ok,[tiger@durin]} (tiger@durin)2> ttb:p(...) ... </code> @@ -443,7 +605,7 @@ ok to the User's Guide and Reference Manuals for the <c>et</c> application. </p> - <p>By giving the format handler <c>et</c>, you can have the + <p>By giving the format handler <c>ttb:get_et_handler()</c>, you can have the trace log presented graphically with <c>et_viewer</c> in the Event Tracer application. <c>ttb</c> provides a few different filters which can be selected from the Filter menu in the @@ -495,9 +657,23 @@ ok filters respectively, except that each module or function can have several vertical lines, one for each process it resides on. </p> - <p>As an example this module is used, and the function - <c>bar:f1()</c> is called from another module <c>foo</c>.</p> + <p>In the next example, modules <c>foo</c> and <c>bar</c> are used:</p> <code type="none"> +-module(foo). +-export([start/0,go/0]). + +start() -> + spawn(?MODULE, go, []). + +go() -> + receive + stop -> + ok; + go -> + bar:f1(), + go() + end. +</code><code type="none"> -module(bar). -export([f1/0,f3/0]). f1() -> @@ -506,12 +682,23 @@ f1() -> f2() -> spawn(?MODULE,f3,[]). f3() -> - ok. </code> - <p>The <c>call</c> and <c>return_to</c> flags are used, and - trace pattern is set on local calls in module <c>bar</c>. - </p> - <p><c>ttb:format("tiger@durin-ttb", [{handler, et}])</c> gives the - following result: + ok.</code> + + <p>Now let's set up the trace.</p> +<code> +(tiger@durin)1>%%First we retrieve the Pid to limit traced processes set +(tiger@durin)1>Pid = foo:start(). +(tiger@durin)2>%%Now we set up tracing +(tiger@durin)2>ttb:tracer(). +(tiger@durin)3>ttb:p(Pid, [call, return_to, procs, set_on_spawn]). +(tiger@durin)4>ttb:tpl(bar, []). +(tiger@durin)5>%%Invoke our test function and see output with et viewer +(tiger@durin)5>Pid ! go. +(tiger@durin)6>ttb:stop({format, {handler, ttb:get_et_handler()}}). +</code> + + <p>This shoud render a result similar to the + following: </p> <p></p> <image file="et_processes.gif"> @@ -520,25 +707,37 @@ f3() -> <image file="et_modsprocs.gif"> <icaption>Filter: "mods_and_procs"</icaption> </image> + + <p>Note, that we can use <c>ttb:start_trace/4</c> function to help + us here:</p> +<code> +(tiger@durin)1>Pid = foo:start(). +(tiger@durin)2>ttb:start_trace([node()], + [{bar,[]}], + {Pid, [call, return_to, procs, set_on_spawn]} + {handler, ttb:get_et_handler()}). +(tiger@durin)3>Pid ! go. +(tiger@durin)4>ttb:stop(format). +</code> + </section> </section> <section> <marker id="fetch_format"></marker> <title>Automatically collect and format logs from all nodes</title> - <p>If the option <c>fetch</c> is given to the <c>ttb:stop/1</c> - function, trace logs and trace information files are fetched - from all nodes after tracing is stopped. The logs are stored in a - new directory named <c>ttb_upload-Timestamp</c> under the working - directory of the trace control node. + <p>By default <c>ttb:stop/1</c> fetches trace logs and + trace information files from all nodes. The logs are stored in a + new directory named <c>ttb_upload-Filename-Timestamp</c> under the working + directory of the trace control node. Fetching may be disabled by + providing the <c>nofetch</c> option to <c>ttb:stop/1</c>. User can + specify a fetch directory of his choice passing the + <c>{fetch_dir, Dir}</c> option. </p> <p>If the option <c>format</c> is given to <c>ttb:stop/1</c>, the trace logs are automatically formatted after tracing is - stopped. Note that <c>format</c> also implies <c>fetch</c>, - i.e. the trace logs will be collected from all nodes as for the - <c>fetch</c> option before they are formatted. All logs in the - upload directory are merged during formatting. - </p> + stopped. + </p> </section> <section> @@ -546,13 +745,18 @@ f3() -> <p>For the tracing functionality, <c>dbg</c> could be used instead of the <c>ttb</c> for setting trace flags on processes and trace patterns for call trace, i.e. the functions <c>p</c>, <c>tp</c>, - <c>tpl</c>, <c>ctp</c>, <c>ctpl</c> and <c>ctpg</c>. The only - thing added by <c>ttb</c> for these functions is that all calls - are stored in the history buffer and can be recalled and stored in - a configuration file. This makes it easy to setup the same trace - environment e.g. if you want to compare two test runs. It also - reduces the amount of typing when using <c>ttb</c> from the erlang - shell. + <c>tpl</c>, <c>ctp</c>, <c>ctpl</c> and <c>ctpg</c>. There are only + two things added by <c>ttb</c> for these functions: + <list type="bulleted"> + <item>all calls are stored in the history buffer and can be + recalled and stored in a configuration file. This makes it + easy to setup the same trace environment e.g. if you want to + compare two test runs. It also reduces the amount of + typing when using <c>ttb</c> from the erlang shell;</item> + <item>shortcuts are provided for the most common match + specifications (in order not to force the user to use + <c>dbg:fun2ms</c> continually</item>). + </list> </p> <p>Use <c>list_history/0</c> to see the content of the history buffer, and <c>run_history/1</c> to re-execute one of the entries. @@ -574,7 +778,8 @@ f3() -> selected entries from the history by calling <c>ttb:write_config(ConfigFile,NumList)</c>, where <c>NumList</c> is a list of integers pointing out the history - entries to write. + entries to write. Moreover, the history buffer is always dumped + to <c>ttb_last_config</c> when <c>ttb:stop/0/1</c> is called. </p> <p>User defined entries can also be written to a config file by calling the function @@ -720,9 +925,7 @@ ok {ok,[{matched,1},{saved,1}]} (tiger@durin)113> dbg:get_tracer(), seq_trace:reset_trace(). true -(tiger@durin)114> ttb:stop(). -ok -(tiger@durin)115> ttb:format("tiger@durin-ttb"). +(tiger@durin)114> ttb:stop(format). ({<0.158.0>,{shell,evaluator,3},tiger@durin}) call dbg:get_tracer() SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin}) {<0.237.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}} @@ -743,9 +946,7 @@ ok (tiger@durin)117> seq_trace:set_token(send,true), dbg:get_tracer(), seq_trace:reset_trace(). true -(tiger@durin)118> ttb:stop(). -ok -(tiger@durin)119> ttb:format("tiger@durin-ttb"). +(tiger@durin)118> ttb:stop(format). SeqTrace [0]: ({<0.158.0>,{shell,evaluator,3},tiger@durin}) {<0.246.0>,dbg,tiger@durin} ! {<0.158.0>,{get_tracer,tiger@durin}} [Serial: {0,1}] diff --git a/lib/observer/src/ttb.erl b/lib/observer/src/ttb.erl index 221b71df6a..072aa165e7 100644 --- a/lib/observer/src/ttb.erl +++ b/lib/observer/src/ttb.erl @@ -18,9 +18,11 @@ %% -module(ttb). -author('[email protected]'). +-author('[email protected]'). %% API --export([tracer/0,tracer/1,tracer/2,p/2,stop/0,stop/1]). +-export([tracer/0,tracer/1,tracer/2,p/2,stop/0,stop/1,start_trace/4]). +-export([get_et_handler/0]). -export([tp/2, tp/3, tp/4, ctp/0, ctp/1, ctp/2, ctp/3, tpl/2, tpl/3, tpl/4, ctpl/0, ctpl/1, ctpl/2, ctpl/3, ctpg/0, ctpg/1, ctpg/2, ctpg/3]). -export([seq_trigger_ms/0,seq_trigger_ms/1]). @@ -34,24 +36,38 @@ -include_lib("kernel/include/file.hrl"). -define(meta_time,5000). +-define(fetch_time, 10000). -define(history_table,ttb_history_table). -define(seq_trace_flags,[send,'receive',print,timestamp]). --define(upload_dir,"ttb_upload"). +-define(upload_dir(Logname),"ttb_upload_"++Logname). +-define(last_config, "ttb_last_config"). +-define(partial_dir, "ttb_partial_result"). -ifdef(debug). --define(get_status,;get_status -> erlang:display(dict:to_list(NodeInfo)),loop(NodeInfo)). +-define(get_status,;get_status -> erlang:display(dict:to_list(NodeInfo),loop(NodeInfo, TraceInfo)). -else. -define(get_status,). -endif. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Shortcut +start_trace(Nodes, Patterns, {Procs, Flags}, Options) -> + {ok, _} = tracer(Nodes, Options), + [{ok, _} = apply(?MODULE, tpl, tuple_to_list(Args)) || Args <- Patterns], + {ok, _} = p(Procs, Flags). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Open a trace port on all given nodes and create the meta data file tracer() -> tracer(node()). +tracer(shell) -> tracer(node(), shell); +tracer(dbg) -> tracer(node(), {shell, only}); tracer(Nodes) -> tracer(Nodes,[]). tracer(Nodes,Opt) -> - start(), - store(tracer,[Nodes,Opt]), {PI,Client,Traci} = opt(Opt), - do_tracer(Nodes,PI,Client,Traci). + %%We use initial Traci as SessionInfo for loop/2 + Pid = start(Traci), + store(tracer,[Nodes,Opt]), + do_tracer(Nodes,PI,Client,[{ttb_control, Pid}|Traci]). do_tracer(Nodes0,PI,Client,Traci) -> Nodes = nods(Nodes0), @@ -59,9 +75,14 @@ do_tracer(Nodes0,PI,Client,Traci) -> do_tracer(Clients,PI,Traci). do_tracer(Clients,PI,Traci) -> + ShellOutput = proplists:get_value(shell, Traci, false), {ClientSucc,Succ} = lists:foldl( fun({N,{local,File},TF},{CS,S}) -> + TF2 = case ShellOutput of + only -> none; + _ -> TF + end, [_Sname,Host] = string:tokens(atom_to_list(N),"@"), case catch dbg:tracer(N,port,dbg:trace_port(ip,0)) of {ok,N} -> @@ -69,8 +90,8 @@ do_tracer(Clients,PI,Traci) -> {ok,T} = dbg:get_tracer(N), rpc:call(N,seq_trace,set_system_tracer,[T]), dbg:trace_client(ip,{Host,Port}, - {fun ip_to_file/2,{file,File}}), - {[{N,{local,File,Port},TF}|CS], [N|S]}; + {fun ip_to_file/2,{{file,File}, ShellOutput}}), + {[{N,{local,File,Port},TF2}|CS], [N|S]}; Other -> display_warning(N,{cannot_open_ip_trace_port, Host, @@ -98,17 +119,54 @@ do_tracer(Clients,PI,Traci) -> {ok,Succ} end. +opt(Opt) when is_list(Opt) -> + opt(Opt,{true,?MODULE,[]}); opt(Opt) -> - opt(Opt,{true,?MODULE,[]}). + opt([Opt]). opt([{process_info,PI}|O],{_,Client,Traci}) -> opt(O,{PI,Client,Traci}); opt([{file,Client}|O],{PI,_,Traci}) -> - opt(O,{PI,Client,Traci}); + opt(O,{PI,Client,[{logfile,get_logname(Client)}|Traci]}); opt([{handler,Handler}|O],{PI,Client,Traci}) -> opt(O,{PI,Client,[{handler,Handler}|Traci]}); +opt([{timer, {MSec, StopOpts}}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{timer,{MSec, StopOpts}}|Traci]}); +opt([{timer, MSec}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{timer,{MSec, []}}|Traci]}); +opt([{overload_check, {MSec,M,F}}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{overload_check,{MSec,M,F}}|Traci]}); +opt([shell|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{shell, true}|Traci]}); +opt([{shell,Type}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{shell, Type}|Traci]}); +opt([resume|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{resume, {true, ?fetch_time}}|Traci]}); +opt([{resume,MSec}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{resume, {true, MSec}}|Traci]}); +opt([{flush,MSec}|O],{PI,Client,Traci}) -> + opt(O,{PI,Client,[{flush, MSec}|Traci]}); opt([],Opt) -> - Opt. + ensure_opt(Opt). + +ensure_opt({PI,Client,Traci}) -> + case {proplists:get_value(flush, Traci), Client} of + {undefined, _} -> ok; + {_, {local, _}} -> exit(flush_unsupported_with_ip_trace_port); + {_,_} -> ok + end, + NeedIpTracer = proplists:get_value(shell, Traci, false) /= false, + case {NeedIpTracer, Client} of + {false, _} -> {PI, Client, Traci}; + {true, ?MODULE} -> {PI, {local, ?MODULE}, Traci}; + {true, {local, File}} -> {PI, {local, File}, Traci}; + {true, _} -> exit(local_client_required_on_shell_tracing) + end. + +get_logname({local, F}) -> get_logname(F); +get_logname({wrap, F}) -> filename:basename(F); +get_logname({wrap, F, _, _}) -> filename:basename(F); +get_logname(F) -> filename:basename(F). nods(all) -> Nodes1 = remove_active([node()|nodes()]), @@ -205,17 +263,29 @@ run_history([H|T]) -> ok -> run_history(T); {error,not_found} -> {error,{not_found,H}} end; + +run_history(all) -> + CurrentHist = ets:tab2list(?history_table), + ets:delete_all_objects(?history_table), + [run_printed(MFA,true) || {_, MFA} <- CurrentHist]; +run_history(all_silent) -> + CurrentHist = ets:tab2list(?history_table), + ets:delete_all_objects(?history_table), + [run_printed(MFA,false) || {_, MFA} <- CurrentHist]; run_history([]) -> ok; run_history(N) -> case catch ets:lookup(?history_table,N) of [{N,{M,F,A}}] -> - print_func(M,F,A), - R = apply(M,F,A), - print_result(R); + run_printed({M,F,A},true); _ -> {error, not_found} end. + +run_printed({M,F,A},Verbose) -> + Verbose andalso print_func(M,F,A), + R = apply(M,F,A), + Verbose andalso print_result(R). write_config(ConfigFile,all) -> write_config(ConfigFile,['_']); @@ -223,6 +293,8 @@ write_config(ConfigFile,Config) -> write_config(ConfigFile,Config,[]). write_config(ConfigFile,all,Opt) -> write_config(ConfigFile,['_'],Opt); +write_config(ConfigFile,Config,Opt) when not(is_list(Opt)) -> + write_config(ConfigFile,Config,[Opt]); write_config(ConfigFile,Nums,Opt) when is_list(Nums), is_integer(hd(Nums)); Nums=:=['_'] -> F = fun(N) -> ets:select(?history_table, @@ -313,6 +385,7 @@ arg_list([A1|A],Acc) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Set trace flags on processes p(Procs0,Flags0) -> + ensure_no_overloaded_nodes(), store(p,[Procs0,Flags0]), no_store_p(Procs0,Flags0). no_store_p(Procs0,Flags0) -> @@ -327,11 +400,12 @@ no_store_p(Procs0,Flags0) -> {error,Reason} -> display_warning(P,Reason), {PMatched,Ps} - end + end end,{[],[]},Procs) of {[],[]} -> {error, no_match}; {SuccMatched,Succ} -> no_store_write_trace_info(flags,{Succ,Flags}), + ?MODULE ! trace_started, {ok,SuccMatched} end end. @@ -339,7 +413,7 @@ no_store_p(Procs0,Flags0) -> transform_flags([clear]) -> [clear]; transform_flags(Flags) -> - dbg:transform_flags(Flags). + dbg:transform_flags([timestamp | Flags]). procs(Procs) when is_list(Procs) -> @@ -365,24 +439,30 @@ proc({global,Name}) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Trace pattern tp(A,B) -> - store(tp,[A,B]), - dbg:tp(A,B). + ensure_no_overloaded_nodes(), + store(tp,[A,ms(B)]), + dbg:tp(A,ms(B)). tp(A,B,C) -> - store(tp,[A,B,C]), - dbg:tp(A,B,C). + ensure_no_overloaded_nodes(), + store(tp,[A,B,ms(C)]), + dbg:tp(A,B,ms(C)). tp(A,B,C,D) -> - store(tp,[A,B,C,D]), - dbg:tp(A,B,C,D). + ensure_no_overloaded_nodes(), + store(tp,[A,B,C,ms(D)]), + dbg:tp(A,B,C,ms(D)). tpl(A,B) -> - store(tpl,[A,B]), - dbg:tpl(A,B). + ensure_no_overloaded_nodes(), + store(tpl,[A,ms(B)]), + dbg:tpl(A,ms(B)). tpl(A,B,C) -> - store(tpl,[A,B,C]), - dbg:tpl(A,B,C). + ensure_no_overloaded_nodes(), + store(tpl,[A,B,ms(C)]), + dbg:tpl(A,B,ms(C)). tpl(A,B,C,D) -> - store(tpl,[A,B,C,D]), - dbg:tpl(A,B,C,D). + ensure_no_overloaded_nodes(), + store(tpl,[A,B,C,ms(D)]), + dbg:tpl(A,B,C,ms(D)). ctp() -> store(ctp,[]), @@ -423,6 +503,56 @@ ctpg(A,B,C) -> store(ctpg,[A,B,C]), dbg:ctpg(A,B,C). +ms(return) -> + [{'_',[],[{return_trace}]}]; +ms(caller) -> + [{'_',[],[{message,{caller}}]}]; +ms({codestr, FunStr}) -> + {ok, MS} = string2ms(FunStr), + MS; +ms(Other) -> + Other. + +ensure_no_overloaded_nodes() -> + Overloaded = case whereis(?MODULE) of + undefined -> + []; + _ -> + ?MODULE ! {get_overloaded, self()}, + receive O -> O end + end, + case Overloaded of + [] -> ok; + Overloaded -> exit({error, overload_protection_active, Overloaded}) + end. + +-spec string2ms(string()) -> {ok, list()} | {error, fun_format}. +string2ms(FunStr) -> + case erl_scan:string(fix_dot(FunStr)) of + {ok, Tokens, _} -> + case erl_parse:parse_exprs(Tokens) of + {ok, [Expression]} -> + case Expression of + {_, _, {clauses, Clauses}} -> + {ok, ms_transform:transform_from_shell(dbg, Clauses, [])}; + _ -> + {error, fun_format} + end; + _ -> + {error, fun_format} + end; + _ ->{error, fun_format} + end. + +-spec fix_dot(string()) -> string(). +fix_dot(FunStr) -> + [H | Rest] = lists:reverse(FunStr), + case H of + $. -> + FunStr; + H -> + lists:reverse([$., H | Rest]) + end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Support for sequential trace @@ -457,66 +587,109 @@ no_store_write_trace_info(Key,What) -> %%% Stop tracing on all nodes stop() -> stop([]). -stop(Opts) -> +stop(Opts) when is_list(Opts) -> Fetch = stop_opts(Opts), - case whereis(?MODULE) of - undefined -> ok; - Pid when is_pid(Pid) -> - ?MODULE ! {stop,Fetch,self()}, - receive {?MODULE,stopped} -> ok end + Result = + case whereis(?MODULE) of + undefined -> ok; + Pid when is_pid(Pid) -> + ?MODULE ! {stop,Fetch,self()}, + receive {?MODULE,R} -> R end + end, + case {Fetch, Result} of + {nofetch, _} -> + ok; + {_, {stopped, _}} -> + %% Printout moved out of the ttb loop to avoid occasional deadlock + io:format("Stored logs in ~s~n", [element(2, Result)]); + {_, _} -> + ok end, - stopped. + stop_return(Result,Opts); +stop(Opts) -> + stop([Opts]). stop_opts(Opts) -> - case lists:member(format,Opts) of - true -> - format; % format implies fetch - false -> - case lists:member(fetch,Opts) of - true -> fetch; - false -> nofetch - end + FetchDir = proplists:get_value(fetch_dir, Opts), + ensure_fetch_dir(FetchDir), + FormatData = case proplists:get_value(format, Opts) of + undefined -> false; + true -> {format, []}; + FOpts -> {format, FOpts} + end, + case {FormatData, lists:member(return_fetch_dir, Opts)} of + {false, true} -> + {fetch, FetchDir}; % if we specify return_fetch_dir, the data should be fetched + {false, false} -> + case lists:member(nofetch,Opts) of + false -> {fetch, FetchDir}; + true -> nofetch + end; + {FormatData, _} -> + {FormatData, FetchDir} + end. + +ensure_fetch_dir(undefined) -> ok; +ensure_fetch_dir(Dir) -> + case filelib:is_file(Dir) of + true -> + throw({error, exists, Dir}); + false -> + ok + end. + +stop_return(R,Opts) -> + case {lists:member(return_fetch_dir,Opts),R} of + {true,_} -> + R; + {false,{stopped,_}} -> + stopped; + {false,_} -> + %% Anything other than 'stopped' would not be bw compatible... + stopped end. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Process implementation -start() -> +start(SessionInfo) -> case whereis(?MODULE) of undefined -> Parent = self(), - Pid = spawn(fun() -> init(Parent) end), - receive {started,Pid} -> ok end; + Pid = spawn(fun() -> init(Parent, SessionInfo) end), + receive {started,Pid} -> ok end, + Pid; Pid when is_pid(Pid) -> - ok + Pid end. - -init(Parent) -> +init(Parent, SessionInfo) -> register(?MODULE,self()), ets:new(?history_table,[ordered_set,named_table,public]), Parent ! {started,self()}, - loop(dict:new()). + NewSessionInfo = [{partials, 0}, {dead_nodes, []} | SessionInfo], + try_send_flush_tick(NewSessionInfo), + loop(dict:new(), NewSessionInfo). -loop(NodeInfo) -> +loop(NodeInfo, SessionInfo) -> receive {init_node,Node,MetaFile,PI,Traci} -> erlang:monitor_node(Node,true), - MetaPid = + {AbsoluteMetaFile, MetaPid} = case rpc:call(Node, observer_backend, ttb_init_node, [MetaFile,PI,Traci]) of - {ok,MP} -> - MP; + {ok,MF,MP} -> + {MF,MP}; {badrpc,nodedown} -> %% We will get a nodedown message - undefined + {MetaFile,undefined} end, - loop(dict:store(Node,{MetaFile,MetaPid},NodeInfo)); + loop(dict:store(Node,{AbsoluteMetaFile,MetaPid},NodeInfo), SessionInfo); {get_nodes,Sender} -> Sender ! {?MODULE,dict:fetch_keys(NodeInfo)}, - loop(NodeInfo); + loop(NodeInfo, SessionInfo); {write_trace_info,Key,What} -> dict:fold(fun(Node,{_MetaFile,MetaPid},_) -> rpc:call(Node,observer_backend, @@ -524,55 +697,121 @@ loop(NodeInfo) -> end, ok, NodeInfo), - loop(NodeInfo); + loop(NodeInfo, SessionInfo); {nodedown,Node} -> - loop(dict:erase(Node,NodeInfo)); - {stop,nofetch,Sender} -> - dict:fold( - fun(Node,{_,MetaPid},_) -> - rpc:call(Node,observer_backend,ttb_stop,[MetaPid]) - end, - ok, - NodeInfo), - dbg:stop_clear(), - ets:delete(?history_table), - Sender ! {?MODULE,stopped}; - {stop,FetchOrFormat,Sender} -> - Localhost = host(node()), - Dir = ?upload_dir++ts(), - file:make_dir(Dir), - %% The nodes are traversed twice here because - %% the meta tracing in observer_backend must be - %% stopped before dbg is stopped, and dbg must - %% be stopped before the trace logs are moved orelse - %% windows complains. - AllNodesAndMeta = - dict:fold( - fun(Node,{MetaFile,MetaPid},Nodes) -> - rpc:call(Node,observer_backend,ttb_stop,[MetaPid]), - [{Node,MetaFile}|Nodes] - end, - [], - NodeInfo), - dbg:stop_clear(), - AllNodes = - lists:map( - fun({Node,MetaFile}) -> - spawn(fun() -> fetch(Localhost,Dir,Node,MetaFile) end), - Node - end, - AllNodesAndMeta), - ets:delete(?history_table), - wait_for_fetch(AllNodes), - io:format("Stored logs in ~s~n",[filename:absname(Dir)]), - case FetchOrFormat of - format -> format(Dir); - fetch -> ok + NewState = make_node_dead(Node, NodeInfo, SessionInfo), + loop(dict:erase(Node,NodeInfo), NewState); + {noderesumed,Node,Reporter} -> + {MetaFile, CurrentSuffix, NewState} = make_node_alive(Node, SessionInfo), + fetch_partial_result(Node, MetaFile, CurrentSuffix), + spawn(fun() -> resume_trace(Reporter) end), + loop(NodeInfo, NewState); + {timeout, StopOpts} -> + spawn(?MODULE, stop, [StopOpts]), + loop(NodeInfo, SessionInfo); + {node_overloaded, Node} -> + io:format("Overload check activated on node: ~p.~n", [Node]), + {Overloaded, SI} = {proplists:get_value(overloaded, SessionInfo, []), + lists:keydelete(overloaded, 1, SessionInfo)}, + loop(NodeInfo, [{overloaded, [Node|Overloaded]} | SI]); + {get_overloaded, Pid} -> + Pid ! proplists:get_value(overloaded, SessionInfo, []), + loop(NodeInfo, SessionInfo); + trace_started -> + case proplists:get_value(timer, SessionInfo) of + undefined -> ok; + {MSec, StopOpts} -> erlang:send_after(MSec, self(), {timeout, StopOpts}) end, - Sender ! {?MODULE,stopped} - ?get_status + loop(NodeInfo, SessionInfo); + flush_timeout -> + [ dbg:flush_trace_port(Node) || Node <- dict:fetch_keys(NodeInfo) ], + try_send_flush_tick(SessionInfo), + loop(NodeInfo, SessionInfo); + {stop,nofetch,Sender} -> + do_stop(nofetch, Sender, NodeInfo, SessionInfo); + {stop,FetchSpec,Sender} -> + case proplists:get_value(shell, SessionInfo, false) of + only -> do_stop(nofetch, Sender, NodeInfo, SessionInfo); + _ -> do_stop(FetchSpec, Sender, NodeInfo, SessionInfo) + end + end. + +do_stop(nofetch, Sender, NodeInfo, _) -> + write_config(?last_config, all), + dict:fold( + fun(Node,{_,MetaPid},_) -> + rpc:call(Node,observer_backend,ttb_stop,[MetaPid]) + end, + ok, + NodeInfo), + dbg:stop_clear(), + ets:delete(?history_table), + Sender ! {?MODULE, stopped}; + +do_stop({FetchOrFormat, UserDir}, Sender, NodeInfo, SessionInfo) -> + write_config(?last_config, all), + Localhost = host(node()), + Dir = get_fetch_dir(UserDir, proplists:get_value(logfile, SessionInfo)), + file:make_dir(Dir), + %% The nodes are traversed twice here because + %% the meta tracing in observer_backend must be + %% stopped before dbg is stopped, and dbg must + %% be stopped before the trace logs are moved orelse + %% windows complains. + AllNodesAndMeta = + dict:fold( + fun(Node,{MetaFile,MetaPid},Nodes) -> + rpc:call(Node,observer_backend,ttb_stop,[MetaPid]), + [{Node,MetaFile}|Nodes] + end, + [], + NodeInfo), + dbg:stop_clear(), + AllNodes = + lists:map( + fun({Node,MetaFile}) -> + spawn(fun() -> fetch_report(Localhost,Dir,Node,MetaFile) end), + Node + end, + AllNodesAndMeta), + ets:delete(?history_table), + wait_for_fetch(AllNodes), + copy_partials(Dir, proplists:get_value(partials, SessionInfo)), + Absname = filename:absname(Dir), + case FetchOrFormat of + fetch -> ok; + {format, Opts} -> format(Dir, Opts) + end, + Sender ! {?MODULE,{stopped,Absname}}. + +make_node_dead(Node, NodeInfo, SessionInfo) -> + {MetaFile,_} = dict:fetch(Node, NodeInfo), + NewDeadNodes = [{Node, MetaFile} | proplists:get_value(dead_nodes, SessionInfo)], + [{dead_nodes, NewDeadNodes} | lists:keydelete(dead_nodes, 1, SessionInfo)]. + +make_node_alive(Node, SessionInfo) -> + DeadNodes = proplists:get_value(dead_nodes, SessionInfo), + Partials = proplists:get_value(partials, SessionInfo), + {value, {_, MetaFile}, Dn2} = lists:keytake(Node, 1, DeadNodes), + SessionInfo2 = lists:keyreplace(dead_nodes, 1, SessionInfo, {dead_nodes, Dn2}), + {MetaFile, Partials + 1, lists:keyreplace(partials, 1, SessionInfo2, {partials, Partials + 1})}. + +try_send_flush_tick(State) -> + case proplists:get_value(flush, State) of + undefined -> + ok; + MSec -> + erlang:send_after(MSec, self(), flush_timeout) end. +get_fetch_dir(undefined,undefined) -> ?upload_dir(?MODULE_STRING) ++ ts(); +get_fetch_dir(undefined,Logname) -> ?upload_dir(Logname) ++ ts(); +get_fetch_dir(Dir,_) -> Dir. + +resume_trace(Reporter) -> + ?MODULE:run_history(all_silent), + Reporter ! trace_resumed. + get_nodes() -> ?MODULE ! {get_nodes,self()}, receive {?MODULE,Nodes} -> Nodes end. @@ -582,19 +821,40 @@ ts() -> io_lib:format("-~4.4.0w~2.2.0w~2.2.0w-~2.2.0w~2.2.0w~2.2.0w", [Y,M,D,H,Min,S]). +copy_partials(_, 0) -> + ok; +copy_partials(Dir, Num) -> + PartialDir = ?partial_dir ++ integer_to_list(Num), + file:rename(PartialDir, filename:join(Dir,PartialDir)), + copy_partials(Dir, Num - 1). + +fetch_partial_result(Node,MetaFile,Current) -> + DirName = ?partial_dir ++ integer_to_list(Current), + case file:list_dir(DirName) of + {error, enoent} -> + ok; + {ok, Files} -> + [ file:delete(filename:join(DirName, File)) || File <- Files ], + file:del_dir(DirName) + end, + file:make_dir(DirName), + fetch(host(node()), DirName, Node, MetaFile). +fetch_report(Localhost, Dir, Node, MetaFile) -> + fetch(Localhost,Dir,Node,MetaFile), + ?MODULE ! {fetch_complete,Node}. fetch(Localhost,Dir,Node,MetaFile) -> - case host(Node) of - Localhost -> % same host, just move the files - Files = rpc:call(Node,observer_backend,ttb_get_filenames,[MetaFile]), + case (host(Node) == Localhost) orelse is_local(MetaFile) of + true -> % same host, just move the files + Files = get_filenames(Node,MetaFile), lists:foreach( - fun(File0) -> - File = filename:join(Dir,filename:basename(File0)), - file:rename(File0,File) - end, - Files); - _Otherhost -> + fun(File0) -> + Dest = filename:join(Dir,filename:basename(File0)), + file:rename(File0, Dest) + end, + Files); + false -> {ok, LSock} = gen_tcp:listen(0, [binary,{packet,2},{active,false}]), {ok,Port} = inet:port(LSock), rpc:cast(Node,observer_backend,ttb_fetch, @@ -603,8 +863,17 @@ fetch(Localhost,Dir,Node,MetaFile) -> receive_files(Dir,Sock,undefined), ok = gen_tcp:close(LSock), ok = gen_tcp:close(Sock) - end, - ?MODULE ! {fetch_complete,Node}. + end. + +is_local({local, _, _}) -> + true; +is_local(_) -> + false. + +get_filenames(_N, {local,F,_}) -> + observer_backend:ttb_get_filenames(F); +get_filenames(N, F) -> + rpc:call(N, observer_backend,ttb_get_filenames,[F]). receive_files(Dir,Sock,Fd) -> case gen_tcp:recv(Sock, 0) of @@ -646,9 +915,16 @@ wait_for_fetch(Nodes) -> %%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - write_info(Nodes,PI,Traci) -> - lists:foreach(fun({N,{local,C,_},F}) -> - MetaFile = F ++ ".ti", - file:delete(MetaFile), + {ok, Cwd} = file:get_cwd(), + lists:foreach(fun({N,{local,C,_},F}) -> + MetaFile = case F of + none -> + none; + F -> + AbsFile = filename:join(Cwd, F) ++ ".ti", + file:delete(AbsFile), + AbsFile + end, Traci1 = [{node,N},{file,C}|Traci], {ok,Port} = dbg:get_tracer(N), ?MODULE ! @@ -662,38 +938,35 @@ write_info(Nodes,PI,Traci) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Format binary trace logs +get_et_handler() -> + {fun ttb_et:handler/4, initial}. + format(Files) -> format(Files,[]). format(Files,Opt) -> - {Out,Handler} = format_opt(Opt), + {Out,Handler,DisableSort} = format_opt(Opt), ets:new(?MODULE,[named_table]), - format(Files,Out,Handler). -format(File,Out,Handler) when is_list(File), is_integer(hd(File)) -> + format(Files,Out,Handler, DisableSort). +format(File,Out,Handler,DisableSort) when is_list(File), is_integer(hd(File)) -> Files = case filelib:is_dir(File) of true -> % will merge all files in the directory - MetaFiles = filelib:wildcard(filename:join(File,"*.ti")), - lists:map(fun(M) -> - Sub = string:left(M,length(M)-3), - case filelib:is_file(Sub) of - true -> Sub; - false -> Sub++".*.wrp" - end - end, - MetaFiles); + List = filelib:wildcard(filename:join(File, ?partial_dir++"*")), + lists:append(collect_files([File | List])); false -> % format one file [File] end, - format(Files,Out,Handler); -format(Files,Out,Handler) when is_list(Files), is_list(hd(Files)) -> + format(Files,Out,Handler,DisableSort); +format(Files,Out,Handler,DisableSort) when is_list(Files), is_list(hd(Files)) -> StopDbg = case whereis(dbg) of undefined -> true; _ -> false end, - Details = lists:foldl(fun(File,Acc) -> [prepare(File,Handler)|Acc] end, + Details = lists:foldl(fun(File,Acc) -> [prepare(File)|Acc] end, [],Files), Fd = get_fd(Out), - R = do_format(Fd,Details), + RealHandler = get_handler(Handler, Files), + R = do_format(Fd,Details,DisableSort,RealHandler), file:close(Fd), ets:delete(?MODULE), case StopDbg of @@ -702,7 +975,30 @@ format(Files,Out,Handler) when is_list(Files), is_list(hd(Files)) -> end, R. -prepare(File,Handler) -> +collect_files(Dirs) -> + lists:map(fun(Dir) -> + MetaFiles = filelib:wildcard(filename:join(Dir,"*.ti")), + lists:map(fun(M) -> + Sub = string:left(M,length(M)-3), + case filelib:is_file(Sub) of + true -> Sub; + false -> Sub++".*.wrp" + end + end, + MetaFiles) + end, Dirs). + +get_handler(undefined, Files) -> + %%We retrieve traci from the first available file + {Traci, _} = read_traci(hd(Files)), + case dict:find(handler, Traci) of + error -> {fun defaulthandler/4, initial}; + {ok, [Handler]} -> Handler + end; +get_handler(Handler, _) -> + Handler. + +prepare(File) -> {Traci,Proci} = read_traci(File), Node = get_node(Traci), lists:foreach(fun({Pid,PI}) -> @@ -714,19 +1010,21 @@ prepare(File,Handler) -> ets:insert(?MODULE,{Pid,PI,Node}) end,Proci), FileOrWrap = get_file(File,Traci), - Handler1 = get_handler(Handler,Traci), - {FileOrWrap,Traci,Handler1}. + {FileOrWrap,Traci}. -format_opt(Opt) -> +format_opt(Opt) when is_list(Opt) -> Out = case lists:keysearch(out,1,Opt) of {value,{out,O}} -> O; _ -> standard_io end, Handler = case lists:keysearch(handler,1,Opt) of - {value,{handler,H}} -> H; - _ -> undefined + {value,{handler,H}} -> H; + _ -> undefined end, - {Out,Handler}. + DisableSort = proplists:get_value(disable_sort, Opt, false), + {Out,Handler,DisableSort}; +format_opt(Opt) -> + format_opt([Opt]). read_traci(File) -> @@ -800,75 +1098,61 @@ check_client(Client,File) when is_tuple(Client),element(2,Client)==wrap -> check_exists(File) -> case file:read_file_info(File) of {ok,#file_info{type=regular}} -> File; - _ -> + _ -> exit({error,no_file}) end. - -get_handler(Handler,Traci) -> - case Handler of - undefined -> - case dict:find(handler,Traci) of - {ok,[H]} -> H; - error -> undefined - end; - _ -> - Handler - end. -do_format(Fd,Details) -> - Clients = lists:foldl(fun({FileOrWrap,Traci,Handler},Acc) -> - [start_client(FileOrWrap,Traci,Handler) - |Acc] +do_format(Fd,Details,DisableSort,Handler) -> + Clients = lists:foldl(fun({FileOrWrap,Traci},Acc) -> + [start_client(FileOrWrap,Traci)|Acc] end,[],Details), - init_collector(Fd,Clients). - - -start_client(FileOrWrap,Traci,et) -> - dbg:trace_client(file, FileOrWrap, - {fun handler/2, - {dict:to_list(Traci),{{ttb_et,handler},initial}}}); -start_client(FileOrWrap,Traci,undefined) -> - dbg:trace_client(file, FileOrWrap, - {fun handler/2, - {dict:to_list(Traci),{fun defaulthandler/4,initial}}}); -start_client(FileOrWrap,Traci,Handler) -> - dbg:trace_client(file, FileOrWrap, - {fun handler/2, {dict:to_list(Traci),Handler}}). - -handler(Trace,State) -> - %% State here is only used for the initial state. The accumulated - %% State is maintained by collector!!! - receive - {get,Collector} -> Collector ! {self(),{Trace,State}}; + init_collector(Fd,Clients,DisableSort,Handler). + +start_client(FileOrWrap,Traci) -> + dbg:trace_client(file, FileOrWrap, + {fun handler/2, dict:to_list(Traci)}). + +handler(Trace,Traci) -> + %%We return our own Traci so that it not necesarry to look it up + %%This may take time if something huge has been written to it + receive + {get,Collector} -> Collector ! {self(),{Trace,Traci}}; done -> ok end, - State. + Traci. -handler1(Trace,{Fd,{Traci,{Fun,State}}}) when is_function(Fun) -> - {Traci,{Fun,Fun(Fd,Trace,Traci,State)}}; -handler1(Trace,{Fd,{Traci,{{M,F},State}}}) when is_atom(M), is_atom(F) -> - {Traci,{{M,F},M:F(Fd,Trace,Traci,State)}}. +%%Used to handle common state (the same for all clients) +handler2(Trace,{Fd,Traci,{Fun,State}}) when is_function(Fun) -> + {Fun, Fun(Fd, Trace, Traci, State)}; +handler2(Trace,{Fd,Traci,{{M,F},State}}) when is_atom(M), is_atom(F) -> + {{M,F}, M:F(Fd, Trace, Traci, State)}. defaulthandler(Fd,Trace,_Traci,initial) -> dbg:dhandler(Trace,Fd); defaulthandler(_Fd,Trace,_Traci,State) -> dbg:dhandler(Trace,State). -init_collector(Fd,Clients) -> +init_collector(Fd,Clients,DisableSort,Handler) -> Collected = get_first(Clients), - collector(Fd,sort(Collected)). + case DisableSort of + true -> collector(Fd,Collected, DisableSort, Handler); + false -> collector(Fd,sort(Collected), DisableSort, Handler) + end. -collector(Fd,[{_,{Client,{Trace,State}}}|Rest]) -> +collector(Fd,[{_,{Client,{Trace,Traci}}} |Rest], DisableSort, CommonState) -> Trace1 = update_procinfo(Trace), - State1 = handler1(Trace1,{Fd,State}), - case get_next(Client,State1) of - end_of_trace -> - handler1(end_of_trace,{Fd,State1}), - collector(Fd,Rest); - Next -> collector(Fd,sort([Next|Rest])) + CommonState2 = handler2(Trace1, {Fd, Traci, CommonState}), + case get_next(Client) of + end_of_trace -> + collector(Fd,Rest,DisableSort, CommonState2); + Next -> case DisableSort of + false -> collector(Fd,sort([Next|Rest]), DisableSort, CommonState2); + true -> collector(Fd,[Next|Rest], DisableSort, CommonState2) + end end; -collector(_Fd,[]) -> +collector(Fd,[], _, CommonState) -> + handler2(end_of_trace, {Fd, end_of_trace, CommonState}), ok. update_procinfo({drop,_N}=Trace) -> @@ -895,7 +1179,7 @@ update_procinfo(Trace) -> ProcInfo = get_procinfo(Pid), setelement(2,Trace,ProcInfo). -get_procinfo(Pid) when is_pid(Pid) -> +get_procinfo(Pid) when is_pid(Pid); is_port(Pid) -> case ets:lookup(?MODULE,Pid) of [PI] -> PI; [] -> Pid @@ -913,21 +1197,21 @@ get_procinfo({Name,Node}) when is_atom(Name) -> get_first([Client|Clients]) -> Client ! {get,self()}, - receive - {Client,{end_of_trace,_}} -> + receive + {Client,{end_of_trace,_}} -> get_first(Clients); - {Client,{Trace,_State}}=Next -> + {Client,{Trace,_}}=Next -> [{timestamp(Trace),Next}|get_first(Clients)] end; get_first([]) -> []. -get_next(Client,State) when is_pid(Client) -> +get_next(Client) when is_pid(Client) -> Client ! {get,self()}, - receive - {Client,{end_of_trace,_}} -> + receive + {Client,{end_of_trace,_}} -> end_of_trace; - {Client,{Trace,_OldState}} -> - {timestamp(Trace),{Client,{Trace,State}}} % inserting new state!! + {Client,{Trace, Traci}} -> + {timestamp(Trace),{Client,{Trace,Traci}}} end. sort(List) -> @@ -971,19 +1255,34 @@ display_warning(Item,Warning) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% Trace client which reads an IP port and puts data directly to a file. %%% This is used when tracing remote nodes with no file system. -ip_to_file(Trace,{file,File}) -> +ip_to_file({metadata,_,_},{_, only} = State) -> + State; +ip_to_file(Trace, {_, only} = State) -> + dbg:dhandler(Trace, standard_io), + State; +ip_to_file(Trace,{{file,File}, ShellOutput}) -> Fun = dbg:trace_port(file,File), %File can be a filename or a wrap spec Port = Fun(), - ip_to_file(Trace,Port); -ip_to_file({metadata,MetaFile,MetaData},Port) -> + case Trace of + {metadata, _, _} -> ok; + Trace -> show_trace(Trace, ShellOutput) + end, + ip_to_file(Trace,{Port,ShellOutput}); +ip_to_file({metadata,MetaFile,MetaData},State) -> {ok,MetaFd} = file:open(MetaFile,[write,raw,append]), file:write(MetaFd,MetaData), file:close(MetaFd), - Port; -ip_to_file(Trace,Port) -> + State; +ip_to_file(Trace,{Port, ShellOutput}) -> + show_trace(Trace, ShellOutput), B = term_to_binary(Trace), erlang:port_command(Port,B), - Port. + {Port, ShellOutput}. + +show_trace(Trace, true) -> + dbg:dhandler(Trace, standard_io); +show_trace(_, _) -> + ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% For debugging @@ -996,5 +1295,3 @@ dump_ti(<<>>,Acc) -> dump_ti(B,Acc) -> {Term,Rest} = get_term(B), dump_ti(Rest,[Term|Acc]). - - diff --git a/lib/observer/test/Makefile b/lib/observer/test/Makefile index 6073e6ea00..bf99f07081 100644 --- a/lib/observer/test/Makefile +++ b/lib/observer/test/Makefile @@ -22,7 +22,10 @@ MODULES = \ observer_SUITE \ crashdump_viewer_SUITE \ etop_SUITE \ + ttb_helper \ ttb_SUITE \ + client \ + server \ crashdump_helper ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/observer/test/client.erl b/lib/observer/test/client.erl new file mode 100644 index 0000000000..e756f9d6e8 --- /dev/null +++ b/lib/observer/test/client.erl @@ -0,0 +1,28 @@ +-module(client). +-compile(export_all). + +init(Node) -> + application:start(runtime_tools), + net_kernel:connect_node(Node). + +init() -> + init(server_node()). + +restart() -> + init:restart(). + +server_node() -> + {ok,HostName} = inet:gethostname(), + list_to_atom("server@" ++ HostName). + +get() -> + erlang:send({server,server_node()}, {get,self()}), + receive Data -> Data + after 1000 -> no_reply + end. + +put(Thing) -> + erlang:send({server,server_node()}, {put,self(),Thing}), + receive ok -> ok + after 1000 -> no_reply + end. diff --git a/lib/observer/test/server.erl b/lib/observer/test/server.erl new file mode 100644 index 0000000000..c1b1fea562 --- /dev/null +++ b/lib/observer/test/server.erl @@ -0,0 +1,43 @@ +-module(server). +-compile(export_all). + +start() -> + application:start(runtime_tools), + Pid = spawn(?MODULE,loop,[[], 0]), + register(server,Pid). + +stop() -> + case lists:member(server, registered()) of + true -> + server ! stop; + false -> + ok + end. + +loop(Data, Num) -> + receive + {put,From,Ting} -> From ! ok, + received(From,Ting), + loop([Ting|Data], Num+1); + {get,From} -> From ! Data, + loop(Data, Num+1); + stop -> stopped; + clear -> loop([], Num+1); + {cnt, From} -> From ! Num, + loop(Data, Num) + end. + +counter() -> + server ! {cnt, self()}, + receive + Num -> + Num + end. + +received(From, Thing) -> + case Thing of + never_send_this_atom -> + loop(Thing, 0); + _ -> + {return, 27, Thing, From} + end. diff --git a/lib/observer/test/ttb_SUITE.erl b/lib/observer/test/ttb_SUITE.erl index 24b4a22aa9..1fd8b4c892 100644 --- a/lib/observer/test/ttb_SUITE.erl +++ b/lib/observer/test/ttb_SUITE.erl @@ -1,7 +1,7 @@ -%% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% +%% Copyright Ericsson AB 2002-2010. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -33,9 +33,17 @@ -include_lib("test_server/include/test_server.hrl"). -define(default_timeout, ?t:minutes(1)). +-define(OUTPUT, "handler_output"). +-define(FNAME, "temptest"). +-define(DIRNAME, "ddtemp"). init_per_testcase(_Case, Config) -> ttb:stop(), + os:cmd("rm -rf " ++ ?OUTPUT), + os:cmd("rm -rf ttb_upload*"), + os:cmd("rm -rf " ++ ?DIRNAME), + os:cmd("rm -rf *@*"), + os:cmd("rm -rf ttb_last_config"), ?line Dog=test_server:timetrap(?default_timeout), [{watchdog, Dog}|Config]. end_per_testcase(_Case, Config) -> @@ -49,7 +57,25 @@ all() -> [file, file_no_pi, file_fetch, wrap, wrap_merge, wrap_merge_fetch_format, write_config1, write_config2, write_config3, history, write_trace_info, seq_trace, - diskless, otp_4967_1, otp_4967_2]. + diskless, diskless_wrap, otp_4967_1, otp_4967_2, + fetch_when_no_option_given, basic_ttb_run_ip_port, basic_ttb_run_file_port, + return_fetch_dir_implies_fetch, logfile_name_in_fetch_dir, upload_to_my_logdir, + upload_to_my_existing_logdir, fetch_with_options_not_as_list, + error_when_formatting_multiple_files_4393, format_on_trace_stop, + trace_to_remote_files_on_localhost_with_different_pwd, + trace_to_local_files_on_localhost_with_different_pwd, + trace_to_remote_files_on_localhost_with_different_pwd_abs, + changing_cwd_on_control_node, changing_cwd_on_remote_node, + changing_cwd_on_control_node_with_local_trace, + one_command_trace_setup, dbg_style_fetch, shell_tracing_init, + only_one_state_for_format_handler, only_one_state_with_default_format_handler, + only_one_state_with_initial_format_handler, run_trace_with_shortcut1, + run_trace_with_shortcut2, run_trace_with_shortcut3, run_trace_with_shortcut4, + cant_specify_local_and_flush, trace_sorted_by_default,disable_sorting, + trace_resumed_after_node_restart, trace_resumed_after_node_restart_ip, + trace_resumed_after_node_restart_wrap, + trace_resumed_after_node_restart_wrap_mult +]. groups() -> []. @@ -92,15 +118,15 @@ file(Config) when is_list(Config) -> ?line {ok,[{matched,_,1},{matched,_,1}]} = ttb:tp(?MODULE,foo,[]), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format(filename:join(Privdir,atom_to_list(Node)++"-file")), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(OtherNode)++"-file")), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ok. @@ -123,15 +149,15 @@ file_no_pi(Config) when is_list(Config) -> ?line {ok,[{matched,_,1},{matched,_,1}]} = ttb:tp(?MODULE,foo,[]), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format(filename:join(Privdir,atom_to_list(Node)++"-file")), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(OtherNode)++"-file")), - ?line [{trace,LocalProc,call,{?MODULE,foo,[]}}, + ?line [{trace_ts,LocalProc,call,{?MODULE,foo,[]}, {_,_,_}}, end_of_trace, - {trace,RemoteProc,call,{?MODULE,foo,[]}}, + {trace_ts,RemoteProc,call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ?line true = is_pid(LocalProc), ?line true = is_pid(RemoteProc), @@ -170,7 +196,7 @@ file_fetch(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ?t:capture_start(), - ?line ttb:stop([fetch]), + ?line ttb:stop([return_fetch_dir]), ?line ?t:capture_stop(), ?line [StoreString] = ?t:capture_get(), ?line UploadDir = @@ -194,9 +220,9 @@ file_fetch(Config) when is_list(Config) -> ?line ok = ttb:format(filename:join(UploadDir, atom_to_list(OtherNode)++"-file_fetch")), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ?line ok = file:set_cwd(Cwd), @@ -224,19 +250,19 @@ wrap(Config) when is_list(Config) -> ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(Node)++"-wrap.*.wrp")), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - {trace,{S,_,Node},call,{?MODULE,foo,[]}}, - {trace,{S,_,Node},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(OtherNode)++"-wrap.*.wrp")), - ?line [{trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), %% Check that merge does not crash even if the timestamp flag is not on. @@ -244,14 +270,13 @@ wrap(Config) when is_list(Config) -> [filename:join(Privdir, atom_to_list(Node)++"-wrap.*.wrp"), filename:join(Privdir, - atom_to_list(OtherNode)++"-wrap.*.wrp")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - {trace,{S,_,Node},call,{?MODULE,foo,[]}}, - {trace,{S,_,Node},call,{?MODULE,foo,[]}}, - end_of_trace, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, - {trace,{_,_,OtherNode},call,{?MODULE,foo,[]}}, + atom_to_list(OtherNode)++"-wrap.*.wrp")],[{disable_sort,true}]), + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ok. @@ -277,7 +302,7 @@ wrap_merge(Config) when is_list(Config) -> ?line rpc:call(OtherNode,?MODULE,foo,[]), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir, @@ -289,7 +314,6 @@ wrap_merge(Config) when is_list(Config) -> {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, {trace_ts,_,call,{?MODULE,foo,[]},_}, {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, - end_of_trace, {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},_}, end_of_trace] = flush(), ok. @@ -330,7 +354,6 @@ wrap_merge_fetch_format(Config) when is_list(Config) -> {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},_}, {trace_ts,{S,_,Node},call,{?MODULE,foo,[]},_}, - end_of_trace, {trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},_}, end_of_trace] = flush(), @@ -360,16 +383,15 @@ write_config1(Config) when is_list(Config) -> ?line ok = ttb:run_config(File), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config1"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_config1")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - end_of_trace, - {trace,Other,call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,Other,call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), case metatest(Other,OtherNode,Privdir,"-write_config1.ti") of @@ -410,16 +432,15 @@ write_config2(Config) when is_list(Config) -> ?line ok = ttb:run_config(File), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config2"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_config2")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - end_of_trace, - {trace,Other,call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,Other,call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), case metatest(Other,OtherNode,Privdir,"-write_config2.ti") of @@ -455,18 +476,18 @@ write_config3(Config) when is_list(Config) -> ?line {ok,[{all,[{matched,_,_},{matched,_,_}]}]} = ttb:p(all,call), ?line {ok,[{matched,_,1},{matched,_,1}]} = ttb:tp(?MODULE,foo,[]), ?line ok = ttb:write_config(File,[1,2]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line [_,_] = ttb:list_config(File), ?line ok = ttb:run_config(File), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config3"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_config3")]), - ?line [] = flush(), %foo is not traced + ?line [end_of_trace] = flush(), %foo is not traced ?line ok = ttb:write_config(File,[{ttb,tp,[?MODULE,foo,[]]}], [append]), @@ -474,16 +495,15 @@ write_config3(Config) when is_list(Config) -> ?line ok = ttb:run_config(File), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir, atom_to_list(Node)++"-write_config3"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_config3")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, - end_of_trace, - {trace,Other,call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, + {trace_ts,Other,call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), case metatest(Other,OtherNode,Privdir,"-write_config3.ti") of @@ -531,12 +551,12 @@ history(Config) when is_list(Config) -> ?line ?MODULE:foo(), ?line ok = ttb:run_history([3,4]), ?line ?MODULE:foo(), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir,atom_to_list(Node)++"-history"), filename:join(Privdir,atom_to_list(OtherNode)++"-history")]), - ?line [{trace,{S,_,Node},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ok. @@ -561,17 +581,16 @@ write_trace_info(Config) when is_list(Config) -> ?line ok = ttb:write_trace_info(mytraceinfo,fun() -> node() end), ?line ?MODULE:foo(), ?line rpc:call(OtherNode,?MODULE,foo,[]), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(OtherNode), ?line ok = ttb:format( [filename:join(Privdir,atom_to_list(Node)++"-write_trace_info"), filename:join(Privdir, atom_to_list(OtherNode)++"-write_trace_info")], [{handler,{fun otherhandler/4,S}}]), - ?line [{{trace,{S,_,Node},call,{?MODULE,foo,[]}},[Node]}, - {end_of_trace,[Node]}, - {{trace,{_,_,OtherNode},call,{?MODULE,foo,[]}},[OtherNode]}, - {end_of_trace,[OtherNode]}] = flush(), + ?line [{{trace_ts,{S,_,Node},call,{?MODULE,foo,[]},{_,_,_}},[Node]}, + {{trace_ts,{_,_,OtherNode},call,{?MODULE,foo,[]},{_,_,_}},[OtherNode]}, + end_of_trace] = flush(), ok. @@ -593,10 +612,10 @@ seq_trace(Config) when is_list(Config) -> ?line Start = spawn(fun() -> seq() end), ?line timer:sleep(300), - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ok = ttb:format( [filename:join(Privdir,atom_to_list(Node)++"-seq_trace")]), - ?line [{trace,StartProc,call,{?MODULE,seq,[]}}, + ?line [{trace_ts,StartProc,call,{?MODULE,seq,[]},{_,_,_}}, {seq_trace,0,{send,{0,1},StartProc,P1Proc,{Start,P2}}}, {seq_trace,0,{send,{1,2},P1Proc,P2Proc,{P1,Start}}}, {seq_trace,0,{send,{2,3},P2Proc,StartProc,{P2,P1}}}, @@ -660,15 +679,41 @@ diskless(Config) when is_list(Config) -> ?line rpc:call(RemoteNode,?MODULE,foo,[]), ?line timer:sleep(500), % needed for the IP port to flush - ?line ttb:stop(), + ?line ttb:stop([nofetch]), ?line ?t:stop_node(RemoteNode), ?line ok = ttb:format(filename:join(Privdir, atom_to_list(RemoteNode)++"-diskless")), - ?line [{trace,{_,_,RemoteNode},call,{?MODULE,foo,[]}}, + ?line [{trace_ts,{_,_,RemoteNode},call,{?MODULE,foo,[]},{_,_,_}}, end_of_trace] = flush(), ok. +diskless_wrap(suite) -> + []; +diskless_wrap(doc) -> + ["Start tracing on diskless remote node, save to local wrapped file"]; +diskless_wrap(Config) when is_list(Config) -> + ?line {ok,RemoteNode} = ?t:start_node(node2,slave,[]), + ?line c:nl(?MODULE), + ?line S = self(), + ?line Privdir=?config(priv_dir, Config), + ?line File = filename:join(Privdir,"diskless"), + ?line {ok,[RemoteNode]} = + ttb:tracer([RemoteNode],[{file, {local, {wrap,File,200,3}}}, + {handler,{fun myhandler/4, S}}]), + ?line {ok,[{all,[{matched,RemoteNode,_}]}]} = ttb:p(all,call), + ?line {ok,[{matched,RemoteNode,1}]} = ttb:tp(?MODULE,foo,[]), + + ?line rpc:call(RemoteNode,?MODULE,foo,[]), + ?line timer:sleep(500), % needed for the IP port to flush + ?line ttb:stop([nofetch]), + ?line ?t:stop_node(RemoteNode), + ?line ok = ttb:format(filename:join(Privdir, + atom_to_list(RemoteNode)++"-diskless.*.wrp")), + + ?line [{trace_ts,{_,_,RemoteNode},call,{?MODULE,foo,[]},{_,_,_}}, + end_of_trace] = flush(), + ok. otp_4967_1(suite) -> []; @@ -715,7 +760,7 @@ otp_4967_2(Config) when is_list(Config) -> io:format("11: ~p",[now()]), ?line true = lists:member(heihopp,Msgs), % the heihopp message itself io:format("13: ~p",[now()]), - ?line {value,{trace,_,send,heihopp,{_,otp_4967,Node}}} = + ?line {value,{trace_ts,_,send,heihopp,{_,otp_4967,Node},{_,_,_}}} = lists:keysearch(heihopp,4,Msgs), % trace trace of the heihopp message io:format("14: ~p",[now()]), ?line end_of_trace = lists:last(Msgs), % end of the trace @@ -728,6 +773,30 @@ myhandler(_Fd,Trace,_,Relay) -> Relay ! Trace, Relay. +simple_call_handler() -> + {fun(A, {trace_ts, _, call, _, _} ,_,_) -> io:format(A, "ok.~n", []); + (_, end_of_trace, _, _) -> ok end, []}. + +marking_call_handler() -> + {fun(_, _, _, initial) -> file:write_file("HANDLER_OK", []); + (_,_,_,_) -> ok end, initial}. + +counter_call_handler() -> + {fun(_, {trace_ts, _, call, _, _} ,_,State) -> State + 1; + (A, end_of_trace, _, State) -> io:format(A,"~p.~n", [State]) end, 0}. + +ret_caller_call_handler() -> + {fun(A, {trace_ts, _, call, _, _, _} ,_,_) -> io:format(A, "ok.~n", []); + (A, {trace_ts, _, return_from, _, _, _}, _, _) -> io:format(A, "ok.~n", []); + (_, _, _, _) -> ok end, []}. + +node_call_handler() -> + {fun(A, {trace_ts, {_,_,Node}, call, _, _} ,_,_) -> io:format(A, "~p.~n", [Node]); + (_, end_of_trace, _, _) -> ok end, []}. + +otherhandler(_Fd,_,end_of_trace,Relay) -> + Relay ! end_of_trace, + Relay; otherhandler(_Fd,Trace,TI,Relay) -> {value,{mytraceinfo,I}} = lists:keysearch(mytraceinfo,1,TI), Relay ! {Trace,I}, @@ -794,3 +863,568 @@ check_gone(Dir,File) -> false -> ok end. + +start_client_and_server() -> + ?line {ok,ClientNode} = ?t:start_node(client,slave,[]), + ?line ok = ttb_helper:c(code, add_paths, [code:get_path()]), + ?line {ok,ServerNode} = ?t:start_node(server,slave,[]), + ?line ok = ttb_helper:s(code, add_paths, [code:get_path()]), + ?line ttb_helper:clear(), + {ServerNode, ClientNode}. + +begin_trace(ServerNode, ClientNode, Dest) -> + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, Dest}]), + ?line ttb:p(all, call), + ?line ttb:tp(server, received, []), + ?line ttb:tp(client, put, []), + ?line ttb:tp(client, get, []). + +begin_trace_local(ServerNode, ClientNode, Dest) -> + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, Dest}]), + ?line ttb:p(all, call), + ?line ttb:tpl(server, received, []), + ?line ttb:tpl(client, put, []), + ?line ttb:tpl(client, get, []). + +check_size(N, Dest, Output, ServerNode, ClientNode) -> + ?line begin_trace(ServerNode, ClientNode, Dest), + ?line case Dest of + {local, _} -> + ?line ttb_helper:msgs_ip(N); + _ -> + ?line ttb_helper:msgs(N) + end, + ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), + ?line ttb:format(D, [{out, Output}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(Output), + ?line true = (N + 1 == length(Ret)). + +fetch_when_no_option_given(suite) -> + []; +fetch_when_no_option_given(doc) -> + ["Fetch when no option given"]; +fetch_when_no_option_given(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, Privdir} = file:get_cwd(), + ?line [] = filelib:wildcard(filename:join(Privdir,"ttb_upload_temptest*")), + begin_trace(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(4), + ?line stopped = ttb:stop(), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line [_] = filelib:wildcard(filename:join(Privdir,"ttb_upload_temptest*")). + +basic_ttb_run_ip_port(suite) -> + []; +basic_ttb_run_ip_port(doc) -> + ["Basic ttb run ip port"]; +basic_ttb_run_ip_port(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line check_size(1, {local, ?FNAME}, ?OUTPUT, ServerNode, ClientNode), + ?line check_size(2, {local, ?FNAME}, ?OUTPUT, ServerNode, ClientNode), + ?line check_size(10, {local, ?FNAME}, ?OUTPUT, ServerNode, ClientNode), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +basic_ttb_run_file_port(suite) -> + []; +basic_ttb_run_file_port(doc) -> + ["Basic ttb run file port"]; +basic_ttb_run_file_port(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line check_size(1, ?FNAME, ?OUTPUT, ServerNode, ClientNode), + ?line check_size(2, ?FNAME, ?OUTPUT, ServerNode, ClientNode), + ?line check_size(10, ?FNAME, ?OUTPUT, ServerNode, ClientNode), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +return_fetch_dir_implies_fetch(suite) -> + []; +return_fetch_dir_implies_fetch(doc) -> + ["Return_fetch_dir implies fetch"]; +return_fetch_dir_implies_fetch(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(2), + ?line {_,_} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +logfile_name_in_fetch_dir(suite) -> + []; +logfile_name_in_fetch_dir(doc) -> + ["Logfile name in fetch dir"]; +logfile_name_in_fetch_dir(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, {local, ?FNAME}), + ?line {_,Dir} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line P1 = lists:nth(3, string:tokens(filename:basename(Dir), "_")), + ?line P2 = hd(string:tokens(P1, "-")), + ?line _File = P2. + +upload_to_my_logdir(suite) -> + []; +upload_to_my_logdir(doc) -> + ["Upload to my logdir"]; +upload_to_my_logdir(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}]), + ?line {stopped,_} = ttb:stop([return_fetch_dir, {fetch_dir, ?DIRNAME}]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line true = filelib:is_file(?DIRNAME), + ?line [] = filelib:wildcard("ttb_upload_"++?FNAME). + +upload_to_my_existing_logdir(suite) -> + []; +upload_to_my_existing_logdir(doc) -> + ["Upload to my existing logdir"]; +upload_to_my_existing_logdir(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line ok = file:make_dir(?DIRNAME), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}]), + ?line {error,_,_} = (catch ttb:stop([return_fetch_dir, {fetch_dir, ?DIRNAME}])), + ?line {stopped,_} = ttb:stop(return_fetch_dir), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +fetch_with_options_not_as_list(suite) -> + []; +fetch_with_options_not_as_list(doc) -> + ["Fetch with options not as list"]; +fetch_with_options_not_as_list(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}]), + ?line {stopped, D} = ttb:stop(return_fetch_dir), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line false = filelib:is_file(?OUTPUT), + ?line ttb:format(D, {out, ?OUTPUT}), + ?line true = filelib:is_file(?OUTPUT). + +error_when_formatting_multiple_files_4393(suite) -> + []; +error_when_formatting_multiple_files_4393(doc) -> + ["Error when formatting multiple files"]; +error_when_formatting_multiple_files_4393(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(2), + ?line {_, Dir} = ttb:stop(return_fetch_dir), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line Files = [filename:join(Dir, atom_to_list(ttb_helper:get_node(server)) ++ "-" ++ ?FNAME), + filename:join(Dir, atom_to_list(ttb_helper:get_node(client)) ++ "-" ++ ?FNAME)], + ?line ok = ttb:format(Files). + +format_on_trace_stop(suite) -> + []; +format_on_trace_stop(doc) -> + ["Format on trace stop"]; +format_on_trace_stop(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, {local, ?FNAME}), + ?line ttb_helper:msgs_ip(2), + ?line file:delete("HANDLER_OK"), + ?line {_,_} = ttb:stop([fetch, return_fetch_dir, {format, {handler, marking_call_handler()}}]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line true = filelib:is_file("HANDLER_OK"), + ?line ok = file:delete("HANDLER_OK"). + +%% The following three tests are for the issue "fixes fetch fail when nodes on the same host +%% have different cwd" +trace_to_remote_files_on_localhost_with_different_pwd(suite) -> + []; +trace_to_remote_files_on_localhost_with_different_pwd(doc) -> + ["Trace to remote files on localhost with different pwd"]; +trace_to_remote_files_on_localhost_with_different_pwd(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line ok = file:set_cwd(".."), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line check_size(2, ?FNAME, ?OUTPUT, ServerNode, ClientNode), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ok = file:set_cwd(OldDir). + +trace_to_local_files_on_localhost_with_different_pwd(suite) -> + []; +trace_to_local_files_on_localhost_with_different_pwd(doc) -> + ["Trace to local files on localhost with different pwd"]; +trace_to_local_files_on_localhost_with_different_pwd(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line ok = file:set_cwd(".."), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line check_size(2, {local, ?FNAME}, ?OUTPUT, ServerNode, ClientNode), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ok = file:set_cwd(OldDir). + +trace_to_remote_files_on_localhost_with_different_pwd_abs(suite) -> + []; +trace_to_remote_files_on_localhost_with_different_pwd_abs(doc) -> + ["Trace to remote files on localhost with different pwd abs"]; +trace_to_remote_files_on_localhost_with_different_pwd_abs(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line ok = file:set_cwd(".."), + ?line {ok, Path} = file:get_cwd(), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line File = filename:join(Path, ?FNAME), + ?line check_size(2, File, ?OUTPUT, ServerNode, ClientNode), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ok = file:set_cwd(OldDir). + +%% Trace is not affected by changes of cwd on control node or remote nodes during tracing +%% (three tests) +changing_cwd_on_control_node(suite) -> + []; +changing_cwd_on_control_node(doc) -> + ["Changing cwd on control node during tracing is safe"]; +changing_cwd_on_control_node(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, ?FNAME), + ?line NumMsgs = 3, + ?line ttb_helper:msgs(NumMsgs), + ?line ok = file:set_cwd(".."), + ?line ttb_helper:msgs(NumMsgs), + ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line true = (2*(NumMsgs + 1) == length(Ret)), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ok = file:set_cwd(OldDir). + +changing_cwd_on_control_node_with_local_trace(suite) -> + []; +changing_cwd_on_control_node_with_local_trace(doc) -> + ["Changing cwd on control node during local tracing is safe"]; +changing_cwd_on_control_node_with_local_trace(Config) when is_list(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, {local, ?FNAME}), + ?line NumMsgs = 3, + ?line ttb_helper:msgs_ip(NumMsgs), + ?line ok = file:set_cwd(".."), + ?line ttb_helper:msgs_ip(NumMsgs), + ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line true = (2*(NumMsgs + 1) == length(Ret)), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ok = file:set_cwd(OldDir). + +changing_cwd_on_remote_node(suite) -> + []; +changing_cwd_on_remote_node(doc) -> + ["Changing cwd on remote node during tracing is safe"]; +changing_cwd_on_remote_node(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace(ServerNode, ClientNode, ?FNAME), + ?line NumMsgs = 2, + ?line ttb_helper:msgs(NumMsgs), + ?line ok = rpc:call(ClientNode, file, set_cwd, [".."]), + ?line ttb_helper:msgs(NumMsgs), + ?line {_, D} = ttb:stop([fetch, return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line true = (2*(NumMsgs + 1) == length(Ret)), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +one_command_trace_setup(suite) -> + []; +one_command_trace_setup(doc) -> + ["One command trace setup"]; +one_command_trace_setup(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line ttb:start_trace([ttb_helper:get_node(client), ttb_helper:get_node(server)], + [{server, received, '_', []}, + {client, put, 1, []}, + {client, get, '_', []}], + {all, call}, + [{file, ?FNAME}]), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop(return_fetch_dir), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, simple_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line 5 = length(Ret). + +dbg_style_fetch(suite) -> + []; +dbg_style_fetch(doc) -> + ["Dbg style fetch"]; +dbg_style_fetch(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line DirSize = length(element(2, file:list_dir("."))), + ?line ttb:start_trace([ttb_helper:get_node(client), ttb_helper:get_node(server)], + [{server, received, '_', []}, + {client, put, 1, []}, + {client, get, '_', []}], + {all, call}, + [{shell, only}]), + ?line DirSize = length(element(2, file:list_dir("."))), + ?line ttb_helper:msgs(2), + ?line DirSize = length(element(2, file:list_dir("."))), + ?line stopped, ttb:stop(format), + %%+1 -> ttb_last_trace + ?line true = (DirSize + 1 == length(element(2, file:list_dir(".")))), + ?line {ok,[{all, [{matched,_,_}, {matched,_,_}]}]} = + ttb:start_trace([ttb_helper:get_node(client), ttb_helper:get_node(server)], + [{server, received, '_', []}, + {client, put, 1, []}, + {client, get, '_', []}], + {all, call}, + [{shell, only}]), + ?line ttb:stop(), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +shell_tracing_init(suite) -> + []; +shell_tracing_init(doc) -> + ["Shell tracing init"]; +shell_tracing_init(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line ttb:tracer([ttb_helper:get_node(client), ttb_helper:get_node(server)], shell), + ?line ttb:stop(), + ?line ttb:tracer([ttb_helper:get_node(client), ttb_helper:get_node(server)], + [{file, {local, ?FNAME}}, shell]), + ?line ttb:stop(), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line local_client_required_on_shell_tracing = try ttb:tracer([ttb_helper:get_node(client), ttb_helper:get_node(server)], + [{file, ?FNAME}, shell]) + catch + exit:local_client_required_on_shell_tracing -> + local_client_required_on_shell_tracing + end. + +only_one_state_for_format_handler(suite) -> + []; +only_one_state_for_format_handler(doc) -> + ["Only one state for format handler"]; +only_one_state_for_format_handler(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_local(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, counter_call_handler()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line [5] = Ret. + +only_one_state_with_default_format_handler(suite) -> + []; +only_one_state_with_default_format_handler(doc) -> + ["Only one state with default format handler"]; +only_one_state_with_default_format_handler(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_local(ServerNode, ClientNode, ?FNAME), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}]), + ?line true = filelib:is_file(?OUTPUT). + +only_one_state_with_initial_format_handler(suite) -> + []; +only_one_state_with_initial_format_handler(doc) -> + ["Only one state with initial format handler"]; +only_one_state_with_initial_format_handler(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}, {handler, counter_call_handler()}]), + ?line ttb:p(all, call), + ?line ttb:tpl(server, received, []), + ?line ttb:tpl(client, put, []), + ?line ttb:tpl(client, get, []), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line [5] = Ret. + +run_trace_with_shortcut(Shortcut, Ret, F) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line {ok, _} = + ttb:tracer([ServerNode,ClientNode],[{file, ?FNAME}]), + ?line ttb:p(all, call), + ?line ttb:F(client, put, Shortcut), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, ret_caller_call_handler()}]), + ?line {ok, Ret} =file:consult(?OUTPUT), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +fun_for(return) -> + {codestr, "fun(_) -> return_trace() end"}; +fun_for(msg_false) -> + {codestr, "fun(_) -> message(false) end"}. + +run_trace_with_shortcut1(suite) -> + []; +run_trace_with_shortcut1(doc) -> + ["Run trace with shortcut 1"]; +run_trace_with_shortcut1(Config) when is_list(Config) -> + ?line run_trace_with_shortcut(caller, [ok,ok], tp), + ?line run_trace_with_shortcut(caller, [ok,ok], tpl). + +run_trace_with_shortcut2(suite) -> + []; +run_trace_with_shortcut2(doc) -> + ["Run trace with shortcut 2"]; +run_trace_with_shortcut2(Config) when is_list(Config) -> + ?line run_trace_with_shortcut(return, [ok,ok], tp), + ?line run_trace_with_shortcut(return, [ok,ok], tpl). + +run_trace_with_shortcut3(suite) -> + []; +run_trace_with_shortcut3(doc) -> + ["Run trace with shortcut 3"]; +run_trace_with_shortcut3(Config) when is_list(Config) -> + ?line run_trace_with_shortcut(fun_for(return), [ok,ok], tp), + ?line run_trace_with_shortcut(fun_for(return), [ok,ok], tpl). + +run_trace_with_shortcut4(suite) -> + []; +run_trace_with_shortcut4(doc) -> + ["Run trace with shortcut 4"]; +run_trace_with_shortcut4(Config) when is_list(Config) -> + ?line run_trace_with_shortcut(fun_for(msg_false), [], tp), + ?line run_trace_with_shortcut(fun_for(msg_false), [], tpl). + +cant_specify_local_and_flush(suite) -> + []; +cant_specify_local_and_flush(doc) -> + ["Can't specify local and flush"]; +cant_specify_local_and_flush(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line flush_unsupported_with_ip_trace_port = try ttb:tracer([ServerNode, ClientNode], [{flush, 1000}, {file, {local, ?FNAME}}]) + catch + exit:flush_unsupported_with_ip_trace_port -> + flush_unsupported_with_ip_trace_port + end, + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode). + +trace_sorted_by_default(suite) -> + []; +trace_sorted_by_default(doc) -> + ["Trace sorted by default"]; +trace_sorted_by_default(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_local(ServerNode, ClientNode, ?FILE), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, node_call_handler()}, {disable_sort, false}]), + {ok, Ret} = file:consult(?OUTPUT), + ?line [ClientNode,ServerNode,ClientNode,ServerNode,ServerNode] = Ret. + +disable_sorting(suite) -> + []; +disable_sorting(doc) -> + ["Disable sorting"]; +disable_sorting(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_local(ServerNode, ClientNode, ?FILE), + ?line ttb_helper:msgs(2), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ServerNode), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, node_call_handler()}, {disable_sort, true}]), + {ok, Ret} = file:consult(?OUTPUT), + ?line [ClientNode,ClientNode,ServerNode,ServerNode,ServerNode] = Ret. + +%% ----------------------------------------------------------------------------- +%% tests for autoresume of tracing +%% ----------------------------------------------------------------------------- + +trace_resumed_after_node_restart(suite) -> + []; +trace_resumed_after_node_restart(doc) -> + ["Test trace resumed after node restart, trace to files on remote node."]; +trace_resumed_after_node_restart(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_with_resume(ServerNode, ClientNode, ?FNAME), + ?line logic(2,6,file). + +trace_resumed_after_node_restart_ip(suite) -> + []; +trace_resumed_after_node_restart_ip(doc) -> + ["Test trace resumed after node restart, trace via tcp/ip to local node."]; +trace_resumed_after_node_restart_ip(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_with_resume(ServerNode, ClientNode, {local, ?FNAME}), + ?line logic(2,6,local). + +trace_resumed_after_node_restart_wrap(suite) -> + []; +trace_resumed_after_node_restart_wrap(doc) -> + ["Test trace resumed after node restart, wrap option."]; +trace_resumed_after_node_restart_wrap(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_with_resume(ServerNode, ClientNode, {wrap, ?FNAME, 10, 4}), + ?line logic(1,4,file). + +trace_resumed_after_node_restart_wrap_mult(suite) -> + []; +trace_resumed_after_node_restart_wrap_mult(doc) -> + ["Test trace resumed after node restart, wrap option, multiple files."]; +trace_resumed_after_node_restart_wrap_mult(Config) when is_list(Config) -> + ?line {ServerNode, ClientNode} = start_client_and_server(), + ?line begin_trace_with_resume(ServerNode, ClientNode, {wrap, ?FNAME, 10, 4}), + ?line logic(20,8,file). + +logic(N, M, TracingType) -> + helper_msgs(N, TracingType), + ?t:stop_node(ttb_helper:get_node(client)), + timer:sleep(2500), + ?line {ok,ClientNode} = ?t:start_node(client,slave,[]), + ?line ok = ttb_helper:c(code, add_paths, [code:get_path()]), + ?line ttb_helper:c(client, init, []), + ?line helper_msgs(N, TracingType), + ?line {_, D} = ttb:stop([return_fetch_dir]), + ?line ?t:stop_node(ttb_helper:get_node(server)), + ?line ?t:stop_node(ClientNode), + ?line ttb:format(D, [{out, ?OUTPUT}, {handler, ret_caller_call_handler2()}]), + ?line {ok, Ret} = file:consult(?OUTPUT), + ?line M = length(Ret). + +begin_trace_with_resume(ServerNode, ClientNode, Dest) -> + ?line {ok, _} = ttb:tracer([ServerNode,ClientNode], [{file, Dest}, resume]), + ?line ttb:p(all, [call, timestamp]), + ?line ttb:tp(server, received, []), + ?line ttb:tp(client, put, []), + ?line ttb:tp(client, get, []). + +ret_caller_call_handler2() -> + {fun(A, {trace_ts, _, call, _, _} ,_,_) -> io:format(A, "ok.~n", []); + (_, _, _, _) -> ok end, []}. + +helper_msgs(N, TracingType) -> + case TracingType of + local -> + ttb_helper:msgs_ip(N); + _ -> + ttb_helper:msgs(N) + end. diff --git a/lib/observer/test/ttb_helper.erl b/lib/observer/test/ttb_helper.erl new file mode 100644 index 0000000000..19fdc0e159 --- /dev/null +++ b/lib/observer/test/ttb_helper.erl @@ -0,0 +1,157 @@ +-module(ttb_helper). %%Nodes control +-compile(export_all). + +%%API +%%get() -> client:get() +%%put(X) -> client:put(X) +%%msgs(N) -> N times client:put(test_msg) +%%clear() -> restart server +%%ensure_running() / stop() -> start/stop nodes +%%get_node(atom) -> return atom@hostname + +-define(NODE_CMD(Name), + "erl -sname " ++ atom_to_list(Name) ++ + " -pa .. -pa . -detached -run ttb_helper send_ok"). +-define(REG_NAME, nc_testing). + +new_fun() -> + fun(_, end_of_trace, _, Dict) -> io:format("~p~n", [dict:to_list(Dict)]); + (_, T, _, Dict) -> case element(2, T) of + {Pid, _, _} -> + dict:update_counter(Pid, 1, Dict); + Pid -> + dict:update_counter(Pid, 1, Dict) + end + end. + +new_fun_2() -> + fun(_, end_of_trace, _, Dict) -> io:format("~p~n", [dict:to_list(Dict)]); + (_, T, _, Dict) -> case element(2, T) of + {_, Name, _} when is_atom(Name)-> + dict:update_counter(Name, 1, Dict); + Pid -> + dict:update_counter(Pid, 1, Dict) + end + + end. + + +ensure_running() -> + try_start_node(server), + try_start_node(client), + clear(). + +try_start_node(Node) -> + global:unregister_name(?REG_NAME), + global:register_name(?REG_NAME, self()), + global:sync(), + N = get_node(Node), + case net_adm:ping(N) of + pong -> + io:format("Node ~p already running~n", [N]); + _ -> + io:format("Starting node ~p... ~p ", [Node, os:cmd(?NODE_CMD(Node))]), + recv() + end. + +clear() -> + s(server, stop, []), + init(). + +stop() -> + s(init, stop, []), + c(init, stop, []). + +msgs(N) -> + [c(client, put, [test_msg]) || _ <- lists:seq(1, N)], + s(server, received, [a,b]), + [dbg:flush_trace_port(Node) || Node <- [get_node(client), get_node(server)]]. + +msgs_ip(N) -> + [c(client, put, [test_msg]) || _ <- lists:seq(1, N)], + s(server, received, [a,b]), + timer:sleep(100). %% allow trace messages to arrive over tcp/ip + +run() -> + ttb({local, "A"}), + msgs(2), + c(erlang, whereis, [ttbt]). + +get() -> c(client, get, []). +put(Thing) -> c(client, put, [Thing]). + +get_node(Node) -> + {ok, Host} = inet:gethostname(), + list_to_atom(atom_to_list(Node) ++ "@" ++ Host). + +trace_setup() -> + ttb:p(all, call), + ttb:tp(server, received, []), + ttb:tp(client, put, []), + ttb:tp(client, get, []). + +ttb() -> ttb("A"). +ttb(File) -> + ttb:tracer([get_node(client), get_node(server)], [{file, File}, resume]), + ttb:p(all, [call, timestamp]), + ttb:tp(client, put, []), + ttb:tp(client, get, []), + ttb:tp(server, received, []). + +tc() -> + TC = example_config_gen:create_trace_case("dummy comment"), + Patterns = example_config_gen:create_pattern(client, put, 1, return), + Flags = example_config_gen:create_flags(all, call), + Merge = example_config_gen:create_merge_conf(show_handler(), "dummy merge comment"), + Merge2 = example_config_gen:create_merge_conf(undefined, "dummy merge comment"), + TC2 = example_config_gen:add_pattern(Patterns, TC), + TC3 = example_config_gen:add_flags(Flags, TC2), + TC4 = example_config_gen:add_merge_conf(Merge, TC3), + TC5 = example_config_gen:add_merge_conf(Merge2, TC4), + example_config_gen:add_nodes([get_node(client), get_node(server)], TC5). + + +show(X) -> + io:format(user, "Showing: ~p~n", [X]). + +state_handler() -> + {fun(_,_,I,S) -> io:format(user, "Got from ~p: ~p~n", [I,S]), S+1 end, 0}. + +show_handler() -> + {fun(A,B,_,_) -> io:format(A, "~p~n", [B]) end, []}. + +opts() -> + [[get_node(client), get_node(server)], + [{server, received, '_', []}, + {client, put, '_', []}, + {client, get, '_', []}], + {all, call}, + [{file, "TEST"}]]. + +overload_check(check) -> + true; +overload_check(_) -> + ok. +%%%Internal +s(M, F, A) -> rpc:call(get_node(server), M, F, A). +c(M, F, A) -> rpc:call(get_node(client), M, F, A). + +send_ok() -> + pong = net_adm:ping(get_node(test)), + global:sync(), + global:send(?REG_NAME, node()). + +init() -> + True = s(server, start, []), + io:format("ok1: ~p~n", [True]), + true = c(client, init, [get_node(server)]). + +recv() -> + receive + Node -> + io:format("Node ~p ready.~n", [Node]), + ok + after 5000 -> + io:format("Startup failed~n",[]), + throw(startup_failed) + end. diff --git a/lib/orber/COSS/CosNaming/Makefile b/lib/orber/COSS/CosNaming/Makefile index d3deec7600..28b4d9cacc 100644 --- a/lib/orber/COSS/CosNaming/Makefile +++ b/lib/orber/COSS/CosNaming/Makefile @@ -124,13 +124,15 @@ docs: # ---------------------------------------------------- # Special Build Targets # ---------------------------------------------------- -$(GEN_FILES): cos_naming_ext.idl cos_naming.idl +IDL-GENERATED: cos_naming_ext.idl cos_naming.idl erlc $(ERL_IDL_FLAGS) +'{this,"CosNaming::NamingContext"}' \ +'{this,"CosNaming::NamingContextExt"}' cos_naming_ext.idl erlc $(ERL_IDL_FLAGS) +'{this,"CosNaming::NamingContext"}' cos_naming.idl + >IDL-GENERATED -# echo "ic:gen(cos_naming, [{this, \"CosNaming::NamingContext\"}]), halt()."| $(ERL) $(ERL_IDL_FLAGS) +$(GEN_FILES): IDL-GENERATED +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/orber/doc/src/Orber/ignore_config_record.inf b/lib/orber/doc/src/Orber/ignore_config_record.inf deleted file mode 100644 index 0a5053eba3..0000000000 --- a/lib/orber/doc/src/Orber/ignore_config_record.inf +++ /dev/null @@ -1 +0,0 @@ -This file makes clearmake use the -T switch for this subdirectory diff --git a/lib/orber/examples/Stack/Makefile b/lib/orber/examples/Stack/Makefile index 6e7f292a04..ccb65038a3 100644 --- a/lib/orber/examples/Stack/Makefile +++ b/lib/orber/examples/Stack/Makefile @@ -64,6 +64,8 @@ HRL_FILES= ERL_FILES= $(MODULES:%=%.erl) +GEN_FILES = $(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES) + JAVA_CLASSES = \ StackClient @@ -101,9 +103,13 @@ docs: test: $(TEST_TARGET_FILES) - -$(GEN_ERL_MODULES:%=%.erl) $(GEN_HRL_FILES): stack.idl +IDL-GENERATED: stack.idl erlc $(ERL_IDL_FLAGS) stack.idl + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Target diff --git a/lib/orber/src/Makefile b/lib/orber/src/Makefile index ccc449333c..ed62c94b98 100644 --- a/lib/orber/src/Makefile +++ b/lib/orber/src/Makefile @@ -227,15 +227,14 @@ docs: # Special Build Targets # ---------------------------------------------------- -$(GEN_ERL_FILES1) $(GEN_HRL_FILES1): $(ERL_TOP)/lib/ic/include/erlang.idl +IDL-GENERATED: $(ERL_TOP)/lib/ic/include/erlang.idl CORBA.idl OrberIFR.idl erlc $(ERL_IDL_FLAGS) $(ERL_TOP)/lib/ic/include/erlang.idl - -$(GEN_ERL_FILES2) $(GEN_HRL_FILES2): CORBA.idl erlc $(ERL_IDL_FLAGS) CORBA.idl + erlc $(ERL_IDL_FLAGS) +'{this,"Orber::IFR"}' OrberIFR.idl + >IDL-GENERATED -$(GEN_ERL_FILES3) $(GEN_HRL_FILES3): OrberIFR.idl - erlc $(ERL_IDL_FLAGS) +'{this,"Orber::IFR"}' \ - OrberIFR.idl +$(GEN_ERL_FILES): IDL-GENERATED +$(TARGET_FILES): IDL-GENERATED $(GEN_ASN_ERL) $(GEN_ASN_HRL): OrberCSIv2.asn1 OrberCSIv2.set.asn erlc $(ERL_COMPILE_FLAGS) $(ASN_FLAGS) +'{inline,"OrberCSIv2"}' OrberCSIv2.set.asn diff --git a/lib/orber/src/corba.erl b/lib/orber/src/corba.erl index ecec768544..989e84f581 100644 --- a/lib/orber/src/corba.erl +++ b/lib/orber/src/corba.erl @@ -947,7 +947,7 @@ handle_cast2(M, F, A, InternalState, State, Ctx) -> {noreply, {InternalState, NewState}} end. -handle_exit(InternalState, State, {undef, [{M, F, _}|_]} = Reason, +handle_exit(InternalState, State, {undef, [{M, F, _, _}|_]} = Reason, OnewayOp, {M, F}, A) -> case catch check_exports(M:module_info(exports), F) of {'EXIT',{undef,_}} -> @@ -979,7 +979,7 @@ handle_exit(InternalState, State, {undef, [{M, F, _}|_]} = Reason, #'OBJ_ADAPTER'{minor=(?ORBER_VMCID bor 4), completion_status=?COMPLETED_MAYBE}) end; -handle_exit(InternalState, State, {undef, [{M2, F2, A2}|_]} = Reason, +handle_exit(InternalState, State, {undef, [{M2, F2, A2, _}|_]} = Reason, OnewayOp, {M, F}, A) -> case catch check_exports(M2:module_info(exports), F2) of {'EXIT',{undef,_}} -> diff --git a/lib/orber/src/orber_diagnostics.erl b/lib/orber/src/orber_diagnostics.erl index c12dbfa896..c115d79524 100644 --- a/lib/orber/src/orber_diagnostics.erl +++ b/lib/orber/src/orber_diagnostics.erl @@ -130,10 +130,10 @@ missing_modules_helper([[Mod, Type]|T], ErrorsFound) when Type == ?IFR_StructDef end; missing_modules_helper([[Mod, Type]|T], ErrorsFound) when Type == ?IFR_InterfaceDef -> case catch Mod:oe_get_interface() of - {'EXIT', {undef,[{Mod, _, _}|_]}} -> + {'EXIT', {undef,[{Mod, _, _, _}|_]}} -> io:format("Missing (Interface): ~p~n", [Mod]), missing_modules_helper(T, ErrorsFound + 1); - {'EXIT', {undef,[{OtherMod, _, _}|_]}} -> + {'EXIT', {undef,[{OtherMod, _, _, _}|_]}} -> io:format("Missing (Inherited by the ~p Interface): ~p~n", [Mod, OtherMod]), missing_modules_helper(T, ErrorsFound + 1); diff --git a/lib/orber/src/orber_ifr.erl b/lib/orber/src/orber_ifr.erl index e56672be93..9631a268e4 100644 --- a/lib/orber/src/orber_ifr.erl +++ b/lib/orber/src/orber_ifr.erl @@ -500,7 +500,7 @@ get_tc(Id, Type) -> case catch Module:tc() of {'EXIT', Reason} -> case Reason of - {undef,[{Module, tc,[]}|_]} -> + {undef,[{Module, tc,[],_}|_]} -> orber:dbg("[~p] ~p:get_tc(~p);~nMissing ~p:tc()~n", [?LINE, ?MODULE, Id, Module], ?DEBUG_LEVEL), corba:raise(#'UNKNOWN'{minor=(?ORBER_VMCID bor 1), diff --git a/lib/orber/test/Makefile b/lib/orber/test/Makefile index b682bcf24b..996d0d1874 100644 --- a/lib/orber/test/Makefile +++ b/lib/orber/test/Makefile @@ -184,31 +184,17 @@ docs: # Special Targets # ---------------------------------------------------- -# -# Each IDL file produces many target files so no pattern -# rule can be used. -# -TGT_ORBER = \ - $(GEN_HRL_ORBER:%=$(IDLOUTDIR)/%) \ - $(GEN_MOD_ORBER:%=$(IDLOUTDIR)/%.erl) -TGT_IIOP = \ - $(GEN_HRL_IIOP:%=$(IDLOUTDIR)/%) \ - $(GEN_MOD_IIOP:%=$(IDLOUTDIR)/%.erl) - -TGT_TEST_SERVER = \ - $(GEN_HRL_TEST_SERVER:%=$(IDLOUTDIR)/%) \ - $(GEN_MOD_TEST_SERVER:%=$(IDLOUTDIR)/%.erl) - -$(TGT_ORBER): orber_test.idl +IDL-GENERATED: orber_test.idl iiop_test.idl orber_test_server.idl erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) orber_test.idl - -$(TGT_IIOP): iiop_test.idl erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) \ +'{preproc_flags,"-I../COSS/CosNaming"}' iiop_test.idl - -$(TGT_TEST_SERVER): orber_test_server.idl erlc $(ERL_IDL_FLAGS) -o$(IDLOUTDIR) \ +'{cfgfile,"orber_test_server.cfg"}' orber_test_server.idl + >IDL-GENERATED + +$(GEN_FILES): IDL-GENERATED + +$(TARGET_FILES): IDL-GENERATED # ---------------------------------------------------- # Release Targets diff --git a/lib/os_mon/c_src/Makefile.in b/lib/os_mon/c_src/Makefile.in index 1a371eb380..b81d3f564b 100644 --- a/lib/os_mon/c_src/Makefile.in +++ b/lib/os_mon/c_src/Makefile.in @@ -82,13 +82,9 @@ ALL_CFLAGS = @CFLAGS@ @DEFS@ $(CFLAGS) # Targets # ---------------------------------------------------- -debug opt: $(OBJDIR) $(BINDIR) $(TARGET_FILES) +_create_dirs := $(shell mkdir -p $(OBJDIR) $(BINDIR)) -$(OBJDIR): - -@mkdir -p $(OBJDIR) - -$(BINDIR): - -@mkdir -p $(BINDIR) +debug opt: $(TARGET_FILES) clean: rm -f $(TARGET_FILES) diff --git a/lib/os_mon/mibs/Makefile b/lib/os_mon/mibs/Makefile index cbbc337491..a361fef378 100644 --- a/lib/os_mon/mibs/Makefile +++ b/lib/os_mon/mibs/Makefile @@ -78,6 +78,9 @@ $(SNMP_BIN_TARGET_DIR)/OTP-MIB.bin: $(ERL_TOP)/lib/$(OTP_MIBDIR)/mibs/OTP-MI v1/%.mib.v1: %.mib $(ERL_TOP)/lib/snmp/bin/snmp-v2tov1 -o $@ $< +$(SNMP_BIN_TARGET_DIR)/OTP-OS-MON-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/OTP-REG.bin \ + $(SNMP_BIN_TARGET_DIR)/OTP-MIB.bin \ # ---------------------------------------------------- # Release Target diff --git a/lib/parsetools/include/yeccpre.hrl b/lib/parsetools/include/yeccpre.hrl index 80a3afbdb6..f638529aa4 100644 --- a/lib/parsetools/include/yeccpre.hrl +++ b/lib/parsetools/include/yeccpre.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -67,7 +67,7 @@ yeccpars0(Tokens, Tzr, State, States, Vstack) -> Error end. -yecc_error_type(function_clause, [{?MODULE,F,ArityOrArgs} | _]) -> +yecc_error_type(function_clause, [{?MODULE,F,ArityOrArgs,_} | _]) -> case atom_to_list(F) of "yeccgoto_" ++ SymbolL -> {ok,[{atom,_,Symbol}],_} = erl_scan:string(SymbolL), diff --git a/lib/parsetools/src/yeccparser.erl b/lib/parsetools/src/yeccparser.erl index 63127802ee..e4b8b06db5 100644 --- a/lib/parsetools/src/yeccparser.erl +++ b/lib/parsetools/src/yeccparser.erl @@ -17,7 +17,7 @@ line_of(Token) -> %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -83,7 +83,7 @@ yeccpars0(Tokens, Tzr, State, States, Vstack) -> Error end. -yecc_error_type(function_clause, [{?MODULE,F,ArityOrArgs} | _]) -> +yecc_error_type(function_clause, [{?MODULE,F,ArityOrArgs,_} | _]) -> case atom_to_list(F) of "yeccgoto_" ++ SymbolL -> {ok,[{atom,_,Symbol}],_} = erl_scan:string(SymbolL), diff --git a/lib/public_key/asn1/Makefile b/lib/public_key/asn1/Makefile index 94abec083c..c4f8d65aa7 100644 --- a/lib/public_key/asn1/Makefile +++ b/lib/public_key/asn1/Makefile @@ -65,7 +65,7 @@ EBIN = ../ebin EXTRA_ERLC_FLAGS = ERL_COMPILE_FLAGS += $(EXTRA_ERLC_FLAGS) -ASN_FLAGS = -bber_bin +der +compact_bit_string +optimize +noobj +asn1config +inline +ASN_FLAGS = -bber_bin +der +compact_bit_string +optimize +noobj +asn1config +inline +nif # ---------------------------------------------------- # Targets @@ -79,7 +79,7 @@ clean: docs: -%.erl: %.set.asn +%.erl %.hrl: %.set.asn erlc $(ASN_FLAGS) $< $(HRL_FILES): $(ASN_HRLS) diff --git a/lib/public_key/doc/src/introduction.xml b/lib/public_key/doc/src/introduction.xml index 8cf11ee10e..a21fcf3576 100644 --- a/lib/public_key/doc/src/introduction.xml +++ b/lib/public_key/doc/src/introduction.xml @@ -48,5 +48,13 @@ of the concepts of using public keys.</p> </section> + <section> + <title>Performance tips</title> + <p>The public_key decode and encode functions will try to use the nifs + which are in the asn1 compilers runtime modules if they can be found. + So for the best performance you want to have the asn1 application in the + path of your system. </p> + </section> + </chapter> diff --git a/lib/runtime_tools/c_src/Makefile.in b/lib/runtime_tools/c_src/Makefile.in index 840de39f07..73ab6cdc11 100644 --- a/lib/runtime_tools/c_src/Makefile.in +++ b/lib/runtime_tools/c_src/Makefile.in @@ -89,42 +89,31 @@ endif # Targets # ---------------------------------------------------- -debug opt: $(OBJDIR) $(BINDIR) $(SOLIBS) +_create_dirs := $(shell mkdir -p $(OBJDIR) $(LIBDIR)) -$(OBJDIR): - -@mkdir -p $(OBJDIR) - -$(BINDIR): - -@mkdir -p $(BINDIR) +debug opt: $(SOLIBS) $(OBJDIR)/%.o: %.c - $(INSTALL_DIR) $(OBJDIR) $(CC) -c -o $@ $(ALL_CFLAGS) $< $(LIBDIR)/trace_ip_drv.so: $(TRACE_IP_DRV_OBJS) - $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ -lc $(LIBS) $(LIBDIR)/trace_file_drv.so: $(TRACE_FILE_DRV_OBJS) - $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ -lc $(LIBS) $(LIBDIR)/trace_ip_drv.dll: $(TRACE_IP_DRV_OBJS) - $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ $(LIBS) $(LIBDIR)/trace_file_drv.dll: $(TRACE_FILE_DRV_OBJS) - $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ $(LIBS) # # VxWorks is simply to different from Unix in this sense. # Here are the inference rules for VxWorks # $(LIBDIR)/trace_ip_drv.eld: $(TRACE_IP_DRV_OBJS) - $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ $(LIBDIR)/trace_file_drv.eld: $(TRACE_FILE_DRV_OBJS) - $(INSTALL_DIR) $(LIBDIR) $(LD) $(LDFLAGS) -o $@ $^ clean: diff --git a/lib/runtime_tools/doc/src/dbg.xml b/lib/runtime_tools/doc/src/dbg.xml index 4e32bd5c0d..c7c5cd4ff0 100644 --- a/lib/runtime_tools/doc/src/dbg.xml +++ b/lib/runtime_tools/doc/src/dbg.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2009</year> + <year>1996</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -316,7 +316,8 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard) c <v>Module = atom() | '_'</v> <v>Function = atom() | '_'</v> <v>Arity = integer() |'_'</v> - <v>MatchSpec = integer() | atom() | [] | match_spec()</v> + <v>MatchSpec = integer() | Built-inAlias | [] | match_spec()</v> + <v>Built-inAlias = x | c | cx</v> <v>MatchDesc = [MatchInfo]</v> <v>MatchInfo = {saved, integer()} | MatchNum</v> <v>MatchNum = {matched, node(), integer()} | {matched, node(), 0, RPCError}</v> @@ -349,8 +350,9 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard) c if the MatchSpec is other than []. The integer <c>N</c> may then be used in subsequent calls to this function and will stand as an - "alias" for the given expression. There are also built-in - aliases named with atoms (see also <c>ltp/0</c> below).</p> + "alias" for the given expression. There are also a couple of + built-in aliases for common expressions, see <c>ltp/0</c> below + for details.</p> <p>If an error is returned, it can be due to errors in compilation of the match specification. Such errors are presented as a list of tuples <c>{error, string()}</c> where @@ -528,6 +530,21 @@ Error: fun containing local erlang function calls ('is_atomm' called in guard) c <p>Match specifications used can be saved in a file (if a read-write file system is present) for use in later debugging sessions, see <c>wtp/1</c> and <c>rtp/1</c></p> + <p>There are three built-in trace patterns: + <c>exception_trace</c>, <c>caller_trace</c> + and <c>caller_exception_trace</c> (or <c>x</c>, <c>c</c> and + <c>cx</c> respectively). + Exception trace sets a trace which will show function names, + parameters, return values and exceptions thrown from functions. + Caller traces display function names, parameters and information + about which function called it. An example using a built-in alias:</p> + <pre> +(x@y)4> <input>dbg:tp(lists,sort,cx).</input> +{ok,[{matched,nonode@nohost,2},{saved,cx}]} +(x@y)4> <input>lists:sort([2,1]).</input> +(<0.32.0>) call lists:sort([2,1]) ({erl_eval,do_apply,5}) +(<0.32.0>) returned from lists:sort/1 -> [1,2] +[1,2]</pre> </desc> </func> <func> diff --git a/lib/runtime_tools/src/Makefile b/lib/runtime_tools/src/Makefile index 4f831f3dd8..46b570210a 100644 --- a/lib/runtime_tools/src/Makefile +++ b/lib/runtime_tools/src/Makefile @@ -46,7 +46,8 @@ MODULES= \ runtime_tools_sup \ dbg \ percept_profile \ - observer_backend + observer_backend \ + ttb_autostart HRL_FILES= ../include/observer_backend.hrl ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl index 56283f4d3d..446de63064 100644 --- a/lib/runtime_tools/src/dbg.erl +++ b/lib/runtime_tools/src/dbg.erl @@ -1449,6 +1449,19 @@ new_pattern_table() -> ets:insert(PT, {exception_trace, term_to_binary(x)}), + ets:insert(PT, + {c, + term_to_binary([{'_',[],[{message,{caller}}]}])}), + ets:insert(PT, + {caller_trace, + term_to_binary(c)}), + ets:insert(PT, + {cx, + term_to_binary([{'_',[],[{exception_trace}, + {message,{caller}}]}])}), + ets:insert(PT, + {caller_exception_trace, + term_to_binary(cx)}), PT. diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index 0f428de07a..9c1f9da5b1 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -31,6 +31,7 @@ ttb_write_binary/2, ttb_stop/1, ttb_fetch/2, + ttb_resume_trace/0, ttb_get_filenames/1]). -define(CHUNKSIZE,8191). % 8 kbytes - 1 byte @@ -92,16 +93,22 @@ etop_collect([], Acc) -> Acc. %% %% ttb backend %% -ttb_init_node(MetaFile,PI,Traci) -> +ttb_init_node(MetaFile_0,PI,Traci) -> if - is_list(MetaFile); - is_atom(MetaFile) -> + is_list(MetaFile_0); + is_atom(MetaFile_0) -> + {ok, Cwd} = file:get_cwd(), + MetaFile = filename:join(Cwd, MetaFile_0), file:delete(MetaFile); true -> % {local,_,_} - ok + MetaFile = MetaFile_0 + end, + case proplists:get_value(resume, Traci) of + {true, _} -> (autostart_module()):write_config(Traci); + _ -> ok end, Self = self(), - MetaPid = spawn(fun() -> ttb_meta_tracer(MetaFile,PI,Self) end), + MetaPid = spawn(fun() -> ttb_meta_tracer(MetaFile,PI,Self,Traci) end), receive {MetaPid,started} -> ok end, MetaPid ! {metadata,Traci}, case PI of @@ -111,13 +118,14 @@ ttb_init_node(MetaFile,PI,Traci) -> false -> ok end, - {ok,MetaPid}. + {ok,MetaFile,MetaPid}. ttb_write_trace_info(MetaPid,Key,What) -> MetaPid ! {metadata,Key,What}, ok. -ttb_meta_tracer(MetaFile,PI,Parent) -> +ttb_meta_tracer(MetaFile,PI,Parent,SessionData) -> + erlang:monitor(process, proplists:get_value(ttb_control, SessionData)), case PI of true -> ReturnMS = [{'_',[],[{return_trace}]}], @@ -130,22 +138,29 @@ ttb_meta_tracer(MetaFile,PI,Parent) -> ok end, Parent ! {self(),started}, - ttb_meta_tracer_loop(MetaFile,PI,dict:new()). + case proplists:get_value(overload_check, SessionData) of + {Ms, M, F} -> + catch M:F(init), + erlang:send_after(Ms, self(), overload_check); + _ -> + ok + end, + ttb_meta_tracer_loop(MetaFile,PI,dict:new(),SessionData). -ttb_meta_tracer_loop(MetaFile,PI,Acc) -> +ttb_meta_tracer_loop(MetaFile,PI,Acc,State) -> receive {trace_ts,_,call,{erlang,register,[Name,Pid]},_} -> ttb_store_meta({pid,{Pid,Name}},MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {trace_ts,_,call,{global,register_name,[Name,Pid]},_} -> ttb_store_meta({pid,{Pid,{global,Name}}},MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {trace_ts,CallingPid,call,{erlang,spawn_opt,[{M,F,Args,_}]},_} -> MFA = {M,F,length(Args)}, NewAcc = dict:update(CallingPid, fun(Old) -> [MFA|Old] end, [MFA], Acc), - ttb_meta_tracer_loop(MetaFile,PI,NewAcc); + ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); {trace_ts,CallingPid,return_from,{erlang,spawn_opt,_Arity},Ret,_} -> case Ret of {NewPid,_Mref} when is_pid(NewPid) -> ok; @@ -158,14 +173,14 @@ ttb_meta_tracer_loop(MetaFile,PI,Acc) -> T end, Acc), - ttb_meta_tracer_loop(MetaFile,PI,NewAcc); + ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); {trace_ts,CallingPid,call,{erlang,Spawn,[M,F,Args]},_} when Spawn==spawn;Spawn==spawn_link -> MFA = {M,F,length(Args)}, NewAcc = dict:update(CallingPid, fun(Old) -> [MFA|Old] end, [MFA], Acc), - ttb_meta_tracer_loop(MetaFile,PI,NewAcc); + ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); {trace_ts,CallingPid,return_from,{erlang,Spawn,_Arity},NewPid,_} when Spawn==spawn;Spawn==spawn_link -> @@ -176,28 +191,53 @@ ttb_meta_tracer_loop(MetaFile,PI,Acc) -> T end, Acc), - ttb_meta_tracer_loop(MetaFile,PI,NewAcc); + ttb_meta_tracer_loop(MetaFile,PI,NewAcc,State); {metadata,Data} when is_list(Data) -> ttb_store_meta(Data,MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {metadata,Key,Fun} when is_function(Fun) -> ttb_store_meta([{Key,Fun()}],MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); {metadata,Key,What} -> ttb_store_meta([{Key,What}],MetaFile), - ttb_meta_tracer_loop(MetaFile,PI,Acc); - - stop when PI=:=true -> - erlang:trace_pattern({erlang,spawn,3},false,[meta]), + ttb_meta_tracer_loop(MetaFile,PI,Acc,State); + overload_check -> + {Ms, M, F} = proplists:get_value(overload_check, State), + case catch M:F(check) of + true -> + erlang:trace(all, false, [all]), + ControlPid = proplists:get_value(ttb_control, State), + ControlPid ! {node_overloaded, node()}, + catch M:F(stop), + ttb_meta_tracer_loop(MetaFile,PI,Acc,lists:keydelete(overload_check, 1, State)); + _ -> + erlang:send_after(Ms, self(), overload_check), + ttb_meta_tracer_loop(MetaFile,PI,Acc, State) + end; + {'DOWN', _, _, _, _} -> + stop_seq_trace(), + self() ! stop, + ttb_meta_tracer_loop(MetaFile,PI,Acc, State); + stop when PI=:=true -> + try_stop_resume(State), + try_stop_overload_check(State), + erlang:trace_pattern({erlang,spawn,3},false,[meta]), erlang:trace_pattern({erlang,spawn_link,3},false,[meta]), erlang:trace_pattern({erlang,spawn_opt,1},false,[meta]), erlang:trace_pattern({erlang,register,2},false,[meta]), erlang:trace_pattern({global,register_name,2},false,[meta]); stop -> - ok + try_stop_resume(State), + try_stop_overload_check(State) + end. + +try_stop_overload_check(State) -> + case proplists:get_value(overload, State) of + undefined -> ok; + {_, M, F} -> catch M:F(stop) end. pnames() -> @@ -222,6 +262,40 @@ pinfo(P,Globals) -> undefined -> [] % the process has terminated end. +autostart_module() -> + element(2, application:get_env(runtime_tools, ttb_autostart_module)). + +try_stop_resume(State) -> + case proplists:get_value(resume, State) of + true -> (autostart_module()):delete_config(); + _ -> ok + end. + +ttb_resume_trace() -> + case (autostart_module()):read_config() of + {error, _} -> + ok; + {ok, Data} -> + Pid = proplists:get_value(ttb_control, Data), + {_, Timeout} = proplists:get_value(resume, Data), + case rpc:call(node(Pid), erlang, whereis, [ttb]) of + Pid -> + Pid ! {noderesumed, node(), self()}, + wait_for_fetch_ready(Timeout); + _ -> + ok + end, + (autostart_module()):delete_config(), + ok + end. + +wait_for_fetch_ready(Timeout) -> + receive + trace_resumed -> + ok + after Timeout -> + ok + end. ttb_store_meta(Data,{local,MetaFile,Port}) when is_list(Data) -> ttb_send_to_port(Port,MetaFile,Data); @@ -273,6 +347,9 @@ ttb_stop(MetaPid) -> %% returns, and then the Port (in {local,MetaFile,Port}) %% cannot be accessed any more. receive {'DOWN', Ref, process, MetaPid, _Info} -> ok end, + stop_seq_trace(). + +stop_seq_trace() -> seq_trace:reset_trace(), seq_trace:set_system_tracer(false). @@ -287,7 +364,7 @@ ttb_fetch(MetaFile,{Port,Host}) -> send_files({Sock,Host},[File|Files]) -> {ok,Fd} = file:open(File,[raw,read,binary]), - gen_tcp:send(Sock,<<1,(list_to_binary(File))/binary>>), + gen_tcp:send(Sock,<<1,(list_to_binary(filename:basename(File)))/binary>>), send_chunks(Sock,Fd), file:delete(File), send_files({Sock,Host},Files); diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index e6dc7a21d4..095567b165 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -22,7 +22,8 @@ {modules, [dbg,observer_backend,percept_profile, inviso_rt,inviso_rt_lib,inviso_rt_meta, inviso_as_lib,inviso_autostart,inviso_autostart_server, - runtime_tools,runtime_tools_sup,erts_alloc_config]}, + runtime_tools,runtime_tools_sup,erts_alloc_config, + ttb_autostart]}, {registered, [runtime_tools_sup,inviso_rt,inviso_rt_meta]}, {applications, [kernel, stdlib]}, % {env, [{inviso_autostart_mod,your_own_autostart_module}]}, diff --git a/lib/runtime_tools/src/runtime_tools_sup.erl b/lib/runtime_tools/src/runtime_tools_sup.erl index 1a872c355d..4fcb2292d0 100644 --- a/lib/runtime_tools/src/runtime_tools_sup.erl +++ b/lib/runtime_tools/src/runtime_tools_sup.erl @@ -38,6 +38,8 @@ init(AutoModArgs) -> Flags = {one_for_one, 0, 3600}, Children = [{inviso_rt, {inviso_rt, start_link_auto, [AutoModArgs]}, - temporary, 3000, worker, [inviso_rt]}], + temporary, 3000, worker, [inviso_rt]}, + {ttb_autostart, {ttb_autostart, start_link, []}, + temporary, 3000, worker, [ttb_autostart]}], {ok, {Flags, Children}}. %% ----------------------------------------------------------------------------- diff --git a/lib/runtime_tools/src/ttb_autostart.erl b/lib/runtime_tools/src/ttb_autostart.erl new file mode 100644 index 0000000000..4c6971c119 --- /dev/null +++ b/lib/runtime_tools/src/ttb_autostart.erl @@ -0,0 +1,55 @@ +%%%------------------------------------------------------------------- +%%% File : ttb_autostart.erl +%%% Author : Bartłomiej Puzoń <[email protected]> +%%% Description : This supervisor is used to resume ttb tracing +%%% Users are able to provide custom restart modules for *_config, as +%%% file:write/read/delete may not be possible on diskless nodes. +%%% +%%% Created : 31 Jul 2010 by <[email protected]> +%%%------------------------------------------------------------------- +-module(ttb_autostart). + +-behaviour(gen_server). + +%% API +-export([start_link/0, + read_config/0, + write_config/1, + delete_config/0]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +-define(DEF_AUTOSTART_MODULE, ?MODULE). +-define(AUTOSTART_FILENAME, "ttb_autostart.bin"). + +start_link() -> + gen_server:start_link(?MODULE, no_args, []). + +delete_config() -> + file:delete(?AUTOSTART_FILENAME). + +read_config() -> + case file:read_file(?AUTOSTART_FILENAME) of + {ok, Data} -> {ok, binary_to_term(Data)}; + Error -> Error + end. + +write_config(Data) -> + file:write_file(?AUTOSTART_FILENAME, term_to_binary(Data)). + +init(no_args) -> + case application:get_env(runtime_tools, ttb_autostart_module) of + {ok, _} -> ok; + undefined -> application:set_env(runtime_tools, ttb_autostart_module, ?DEF_AUTOSTART_MODULE) + end, + observer_backend:ttb_resume_trace(), + %%As the process is not needed any more, it will shut itself down + {ok, no_args, 10000}. + +handle_call(_,_,_) -> {noreply, no_args}. +handle_cast(_,_) -> {noreply, no_args}. +handle_info(timeout,_) -> {stop, normal, no_args}. +terminate(_,_) -> ok. +code_change(_,_,_) -> {ok, no_args}. diff --git a/lib/snmp/mibs/Makefile.in b/lib/snmp/mibs/Makefile.in index 3af74eca75..993a67c6f2 100644 --- a/lib/snmp/mibs/Makefile.in +++ b/lib/snmp/mibs/Makefile.in @@ -41,8 +41,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/snmp-$(VSN) # ---------------------------------------------------- # NOTE: -# 1) Order is important; some MIBs include others -# 2) The OTP-REG mib actually belongs to another +# The OTP-REG mib actually belongs to another # application (otp_mibs), and is exported by this # app. But since that app is built later, we have # to built it here in order to be able to build @@ -148,6 +147,35 @@ $(ERL_TOP)/lib/snmp/bin/snmp-v2tov1: $(ERL_TOP)/lib/snmp/bin/snmp-v2tov1.src $(SNMP_BIN_TARGET_DIR)/OTP-REG.bin: $(ERL_TOP)/lib/$(OTP_MIBDIR)/mibs/OTP-REG.mib $(ERLC) -pa $(SNMP_TOOLKIT)/ebin -I $(SNMP_TOOLKIT)/priv/mibs $(SNMP_FLAGS) -o $(SNMP_BIN_TARGET_DIR) $< +# To support parallel make, we'll need explicit dependencies +# to ensure that an imported MIB has been compiled when it's needed. + +$(SNMP_BIN_TARGET_DIR)/STANDARD-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/RFC1213-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/SNMP-TARGET-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/SNMP-FRAMEWORK-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/SNMP-NOTIFICATION-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/SNMP-FRAMEWORK-MIB.bin \ + $(SNMP_BIN_TARGET_DIR)/SNMP-TARGET-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/SNMP-COMMUNITY-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/SNMP-FRAMEWORK-MIB.bin \ + $(SNMP_BIN_TARGET_DIR)/SNMP-TARGET-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/SNMP-USER-BASED-SM-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/SNMP-FRAMEWORK-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/SNMP-VIEW-BASED-ACM-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/SNMP-FRAMEWORK-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/SNMP-USM-AES-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/SNMP-FRAMEWORK-MIB.bin + +$(SNMP_BIN_TARGET_DIR)/OTP-SNMPEA-MIB.bin: \ + $(SNMP_BIN_TARGET_DIR)/OTP-REG.bin + clean: rm -f $(TARGET_FILES) @@ -185,7 +213,7 @@ info: @echo "VSN = $(VSN)" @echo "RELSYSDIR = $(RELSYSDIR)" -v1/%.mib.v1: %.mib +v1/%.mib.v1: %.mib $(ERL_TOP)/lib/snmp/bin/snmp-v2tov1 $(ERL_TOP)/lib/snmp/bin/snmp-v2tov1 -o $@ $< diff --git a/lib/snmp/src/agent/snmpa_set_lib.erl b/lib/snmp/src/agent/snmpa_set_lib.erl index 191029f6db..00c77a0cdb 100644 --- a/lib/snmp/src/agent/snmpa_set_lib.erl +++ b/lib/snmp/src/agent/snmpa_set_lib.erl @@ -378,15 +378,15 @@ dbg_apply(M,F,A) -> Res end, case Result of - {'EXIT', {undef, [{M, F, A} | _]}} -> + {'EXIT', {undef, [{M, F, A, _} | _]}} -> {'EXIT', {hook_undef, {M, F, A}}}; - {'EXIT', {function_clause, [{M, F, A} | _]}} -> + {'EXIT', {function_clause, [{M, F, A, _} | _]}} -> {'EXIT', {hook_function_clause, {M, F, A}}}; % XXX: Old format for compatibility - {'EXIT', {undef, {M, F, A}}} -> + {'EXIT', {undef, {M, F, A, _}}} -> {'EXIT', {hook_undef, {M, F, A}}}; - {'EXIT', {function_clause, {M, F, A}}} -> + {'EXIT', {function_clause, {M, F, A, _}}} -> {'EXIT', {hook_function_clause, {M, F, A}}}; Result -> diff --git a/lib/snmp/test/Makefile b/lib/snmp/test/Makefile index 5530805bc1..78ffb1c255 100644 --- a/lib/snmp/test/Makefile +++ b/lib/snmp/test/Makefile @@ -220,6 +220,10 @@ appup: make $(MAYBE_ESTOP) +$(SNMP_BIN_TARGET_DIR)/Klas4.bin: $(SNMP_BIN_TARGET_DIR)/Klas3.bin + +$(SNMP_BIN_TARGET_DIR)/SA-MIB.bin: $(SNMP_BIN_TARGET_DIR)/OLD-SNMPEA-MIB.bin + # ---------------------------------------------------- # Release Target # ---------------------------------------------------- diff --git a/lib/ssh/src/Makefile b/lib/ssh/src/Makefile index 42880fa80b..e7cf2c6723 100644 --- a/lib/ssh/src/Makefile +++ b/lib/ssh/src/Makefile @@ -127,13 +127,10 @@ $(APP_TARGET): $(APP_SRC) ../vsn.mk $(APPUP_TARGET): $(APPUP_SRC) ../vsn.mk sed -e 's;%VSN%;$(VSN);' $< > $@ -%.hrl: %.asn1 - erlc $(ASN_FLAGS) $< +%.erl %.hrl: %.asn1 + $(ERLC) $(ASN_FLAGS) $< -DSS.hrl DSS.erl: DSS.asn1 -PKCS-1.hrl PKCS-1.erl: PKCS-1.asn1 - -$(EBIN)/ssh_file.$(EMULATOR): $(ASN_HRLS) +$(EBIN)/ssh_file.$(EMULATOR) $(EBIN)/ssh_rsa.$(EMULATOR): $(ASN_HRLS) docs: diff --git a/lib/ssl/c_src/Makefile.in b/lib/ssl/c_src/Makefile.in index 6e413e7e8e..a894e6dcd7 100644 --- a/lib/ssl/c_src/Makefile.in +++ b/lib/ssl/c_src/Makefile.in @@ -157,13 +157,9 @@ endif # Targets # ---------------------------------------------------- -debug opt: $(OBJDIR) $(BINDIR) $(OBJS) $(PORT_PROGRAM) $(SSL_MAKEFILE) +_create_dirs := $(shell mkdir -p $(OBJDIR) $(BINDIR)) -$(OBJDIR): - -@mkdir -p $(OBJDIR) - -$(BINDIR): - -@mkdir -p $(BINDIR) +debug opt: $(OBJS) $(PORT_PROGRAM) $(SSL_MAKEFILE) $(OBJDIR)/esock_openssl$(obj): esock_openssl.c $(CC) -c -o $@ $(ALL_CFLAGS) $(SSL_INCLUDE) $< diff --git a/lib/ssl/doc/src/ssl_distribution.xml b/lib/ssl/doc/src/ssl_distribution.xml index 7bcc12eb5f..a2c7370ddc 100644 --- a/lib/ssl/doc/src/ssl_distribution.xml +++ b/lib/ssl/doc/src/ssl_distribution.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2000</year><year>2010</year> + <year>2000</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -33,36 +33,32 @@ </header> <p>This chapter describes how the Erlang distribution can use SSL to get additional verification and security. - - <note><p>Note this - documentation is written for the old ssl implementation and - will be updated for the new one once this functionality is - supported by the new implementation.</p></note> </p> <section> <title>Introduction</title> <p>The Erlang distribution can in theory use almost any connection based protocol as bearer. A module that implements the protocol - specific parts of connection setup is however needed. The + specific parts of the connection setup is however needed. The default distribution module is <c>inet_tcp_dist</c> which is included in the Kernel application. When starting an Erlang node distributed, <c>net_kernel</c> uses this module to setup listen ports and connections. </p> - <p>In the SSL application there is an additional distribution - module, <c>inet_ssl_dist</c> which can be used as an + + <p>In the SSL application there is an additional distribution + module, <c>inet_tls_dist</c> which can be used as an alternative. All distribution connections will be using SSL and all participating Erlang nodes in a distributed system must use this distribution module.</p> - <p>The security depends on how the connections are set up, one can - use key files or certificates to just get a encrypted - connection. One can also make the SSL package verify the - certificates of other nodes to get additional security. - Cookies are however always used as they can be used to - differentiate between two different Erlang networks.</p> + + <p>The security level depends on the parameters provided to the + SSL connection setup. Erlang node cookies are however always + used, as they can be used to differentiate between two different + Erlang networks.</p> <p>Setting up Erlang distribution over SSL involves some simple but necessary steps:</p> - <list type="bulleted"> + + <list type="bulleted"> <item>Building boot scripts including the SSL application</item> <item>Specifying the distribution module for net_kernel</item> <item>Specifying security options and other SSL options</item> @@ -77,122 +73,135 @@ SASL application. Refer to the SASL documentations for more information on systools. This is only an example of what can be done.</p> - <p>The simplest boot script possible includes only the Kernel + + <p>The simplest boot script possible includes only the Kernel and STDLIB applications. Such a script is located in the Erlang distributions bin directory. The source for the script can be found under the Erlang installation top directory under - <c><![CDATA[releases/<OTP version>start_clean.rel]]></c>. Copy that + <c><![CDATA[releases/<OTP version>/start_clean.rel]]></c>. Copy that script to another location (and preferably another name) - and add the SSL application with its current version number + and add the applications crypto, public_key and SSL with their current version numbers after the STDLIB application.</p> <p>An example .rel file with SSL added may look like this:</p> + <code type="none"> -{release, {"OTP APN 181 01","P7A"}, {erts, "5.0"}, - [{kernel,"2.5"}, - {stdlib,"1.8.1"}, - {ssl,"2.2.1"}]}. </code> - <p>Note that the version numbers surely will differ in your system. - Whenever one of the applications included in the script is - upgraded, the script has to be changed.</p> - <p>Assuming the above .rel file is stored in a file - <c>start_ssl.rel</c> in the current directory, a boot script - can be built like this:</p> - <code type="none"> -1> systools:make_script("start_ssl",[]). </code> - <p>There will now be a file <c>start_ssl.boot</c> in the current - directory. To test the boot script, start Erlang with the - <c>-boot</c> command line parameter specifying this boot script - (with its full path but without the <c>.boot</c> suffix), in - Unix it could look like this:</p> - <p></p> - <code type="none"><![CDATA[ + {release, {"OTP APN 181 01","R15A"}, {erts, "5.9"}, + [{kernel,"2.15"}, + {stdlib,"1.18"}, + {crypto, "2.0.3"}, + {public_key, "0.12"}, + {ssl, "5.0"} + ]}. + </code> + + <p>Note that the version numbers surely will differ in your system. + Whenever one of the applications included in the script is + upgraded, the script has to be changed.</p> + <p>Assuming the above .rel file is stored in a file + <c>start_ssl.rel</c> in the current directory, a boot script + can be built like this:</p> + + <code type="none"> + 1> systools:make_script("start_ssl",[]). </code> + + <p>There will now be a file <c>start_ssl.boot</c> in the current + directory. To test the boot script, start Erlang with the + <c>-boot</c> command line parameter specifying this boot script + (with its full path but without the <c>.boot</c> suffix), in + Unix it could look like this:</p> + <p></p> + + <code type="none"><![CDATA[ $ erl -boot /home/me/ssl/start_ssl Erlang (BEAM) emulator version 5.0 Eshell V5.0 (abort with ^G) -1> whereis(ssl_server). -<0.32.0> ]]></code> +1> whereis(ssl_manager). +<0.41.0> ]]></code> <p>The <c>whereis</c> function call verifies that the SSL application is really started.</p> - <p>As an alternative to building a bootscript, one can explicitly - add the path to the ssl <c>ebin</c> directory on the command + + <p>As an alternative to building a bootscript, one can explicitly + add the path to the SSL <c>ebin</c> directory on the command line. This is done with the command line option <c>-pa</c>. This - works as the ssl application really need not be started for the - distribution to come up, a primitive version of the ssl server - is started by the distribution module itself, so as long as the - primitive code server can reach the code, the distribution will + works as the SSL application does not need to be started for the + distribution to come up, as a clone of the SSL application is + hooked into the kernel application, so as long as the + SSL applications code can be reached, the distribution will start. The <c>-pa</c> method is only recommended for testing purposes.</p> + + <note><p>Note that the clone of the SSL application is necessary to + enable the use of the SSL code in such an early bootstage as + needed to setup the distribution, however this will make it + impossible to soft upgrade the SSL application.</p></note> </section> <section> <title>Specifying distribution module for net_kernel</title> - <p>The distribution module for SSL is named <c>inet_ssl_dist</c> - and is specified on the command line whit the <c>-proto_dist</c> + <p>The distribution module for SSL is named <c>inet_tls_dist</c> + and is specified on the command line with the <c>-proto_dist</c> option. The argument to <c>-proto_dist</c> should be the module name without the <c>_dist</c> suffix, so this distribution - module is specified with <c>-proto_dist inet_ssl</c> on the + module is specified with <c>-proto_dist inet_tls</c> on the command line.</p> <p></p> + <p>Extending the command line from above gives us the following:</p> <code type="none"> -$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_ssl </code> - <p>For the distribution to actually be started, we need to give - the emulator a name as well:</p> +$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls </code> + +<p>For the distribution to actually be started, we need to give +the emulator a name as well:</p> <code type="none"> -$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_ssl -sname ssl_test +$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls -sname ssl_test Erlang (BEAM) emulator version 5.0 [source] Eshell V5.0 (abort with ^G) (ssl_test@myhost)1> </code> <p>Note however that a node started in this way will refuse to talk - to other nodes, as no certificates or key files are supplied + to other nodes, as no ssl parameters are supplied (see below).</p> - <p>When the SSL distribution starts, the OTP system is in its - early boot stage, why neither <c>application</c> nor <c>code</c> - are usable. As SSL needs to start a port program in this early - stage, it tries to determine the path to that program from the - primitive code loaders code path. If this fails, one need to - specify the directory where the port program resides. This can - be done either with an environment variable - <c>ERL_SSL_PORTPROGRAM_DIR</c> or with the command line option - <c>-ssl_portprogram_dir</c>. The value should be the directory - where the <c>ssl_esock</c> port program is located. Note that - this option is never needed in a normal Erlang installation.</p> </section> <section> - <title>Specifying security options and other SSL options</title> - <p>For SSL to work, you either need certificate files or a - key file. Certificate files can be specified both when working as - client and as server (connecting or accepting). </p> - <p></p> + <title>Specifying SSL options</title> <p>For SSL to work, at least + a public key and certificate needs to be specified for the server + side. In the following example the PEM-files consists of two + entries the servers certificate and its private key.</p> + <p>On the <c>erl</c> command line one can specify options that the - ssl distribution will add when creation a socket. It is - mandatory to specify at least a key file or client and server - certificates. One can specify any <em>SSL option</em> on the - command line, but must not specify any socket options (like - packet size and such). The SSL options are listed in the - Reference Manual. The only difference between the - options in the reference manual and the ones that can be - specified to the distribution on the command line is that - <c>certfile</c> can (and usually needs to) be specified as - <c>client_certfile</c> and <c>server_certfile</c>. The - <c>client_certfile</c> is used when the distribution initiates a - connection to another node and the <c>server_certfile</c> is used - when accepting a connection from a remote node. </p> - <p>The command line argument for specifying the SSL options is named - <c>-ssl_dist_opt</c> and should be followed by an even number of - SSL options/option values. The <c>-ssl_dist_opt</c> argument can - be repeated any number of times.</p> - <p>An example command line would now look something like this + SSL distribution will add when creating a socket.</p> + + <p>One can specify the simpler SSL options certfile, keyfile, + password, cacertfile, verify, reuse_sessions, + secure_renegotiation, depth, hibernate_after and ciphers (use old + string format) by adding the prefix server_ or client_ to the + option name. The server can also take the options dhfile and + fail_if_no_peer_cert (also prefixed). + <c>client_</c>-prfixed options are used when the distribution initiates a + connection to another node and the <c>server_</c>-prefixed options are used + when accepting a connection from a remote node. </p> + + <p> More complex options such as verify_fun are not available at + the moment but a mechanism to handle such options may be added in + a future release. </p> + + <p> Raw socket options such as packet and size must not be specified on + the command line</p>. + + <p>The command line argument for specifying the SSL options is named + <c>-ssl_dist_opt</c> and should be followed by pairs of + SSL options and their values. The <c>-ssl_dist_opt</c> argument can + be repeated any number of times.</p> + + <p>An example command line would now look something like this (line breaks in the command are for readability, they should not be there when typed):</p> <code type="none"> -$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_ssl - -ssl_dist_opt client_certfile "/home/me/ssl/erlclient.pem" +$ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls -ssl_dist_opt server_certfile "/home/me/ssl/erlserver.pem" - -ssl_dist_opt verify 1 depth 1 + -ssl_dist_opt server_secure_renegotiation true client_secure_renegotiate true -sname ssl_test Erlang (BEAM) emulator version 5.0 [source] @@ -211,12 +220,11 @@ Eshell V5.0 (abort with ^G) subsequent invocations of Erlang.</p> <p></p> <p>In a Unix (Bourne) shell it could look like this (line breaks for - readability):</p> + readability, they should not be there when typed):</p> <code type="none"> -$ ERL_FLAGS="-boot \\"/home/me/ssl/start_ssl\\" -proto_dist inet_ssl - -ssl_dist_opt client_certfile \\"/home/me/ssl/erlclient.pem\\" - -ssl_dist_opt server_certfile \\"/home/me/ssl/erlserver.pem\\" - -ssl_dist_opt verify 1 -ssl_dist_opt depth 1" +$ ERL_FLAGS="-boot /home/me/ssl/start_ssl -proto_dist inet_tls + -ssl_dist_opt server_certfile /home/me/ssl/erlserver.pem + -ssl_dist_opt server_secure_renegotiation true client_secure_renegotiate true" $ export ERL_FLAGS $ erl -sname ssl_test Erlang (BEAM) emulator version 5.0 [source] @@ -227,15 +235,12 @@ Eshell V5.0 (abort with ^G) {progname,["erl "]}, {sname,["ssl_test"]}, {boot,["/home/me/ssl/start_ssl"]}, - {proto_dist,["inet_ssl"]}, - {ssl_dist_opt,["client_certfile","/home/me/ssl/erlclient.pem"]}, + {proto_dist,["inet_tls"]}, {ssl_dist_opt,["server_certfile","/home/me/ssl/erlserver.pem"]}, - {ssl_dist_opt,["verify","1"]}, - {ssl_dist_opt,["depth","1"]}, + {ssl_dist_opt,["server_secure_renegotiation","true", + "client_secure_renegotiate","true"] {home,["/home/me"]}] </code> <p>The <c>init:get_arguments()</c> call verifies that the correct arguments are supplied to the emulator. </p> </section> </chapter> - - diff --git a/lib/ssl/doc/src/ssl_protocol.xml b/lib/ssl/doc/src/ssl_protocol.xml index ca5cc8bc7a..17268a634d 100644 --- a/lib/ssl/doc/src/ssl_protocol.xml +++ b/lib/ssl/doc/src/ssl_protocol.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2003</year><year>2010</year> + <year>2003</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -25,18 +25,18 @@ <file>ssl_protocol.xml</file> </header> - <p>The erlang ssl application currently supports SSL 3.0 and TLS 1.0 + <p>The erlang SSL application currently supports SSL 3.0 and TLS 1.0 RFC 2246, and will in the future also support later versions of TLS. SSL 2.0 is not supported. </p> - <p>By default erlang ssl is run over the TCP/IP protocol even + <p>By default erlang SSL is run over the TCP/IP protocol even though you could plug in any other reliable transport protocol with the same API as gen_tcp.</p> <p>If a client and server wants to use an upgrade mechanism, such as - defined by RFC2817, to upgrade a regular TCP/IP connection to an ssl - connection the erlang ssl API supports this. This can be useful for + defined by RFC2817, to upgrade a regular TCP/IP connection to an SSL + connection the erlang SSL API supports this. This can be useful for things such as supporting HTTP and HTTPS on the same port and implementing virtual hosting. </p> @@ -131,7 +131,7 @@ connections. Sessions are used to avoid the expensive negotiation of new security parameters for each connection."</p> - <p>Session data is by default kept by the ssl application in a + <p>Session data is by default kept by the SSL application in a memory storage hence session data will be lost at application restart or takeover. Users may define their own callback module to handle session data storage if persistent data storage is @@ -140,8 +140,8 @@ possible to configure the amount of time the session data should be saved.</p> - <p>Ssl clients will by default try to reuse an available session, - ssl servers will by default agree to reuse sessions when clients + <p>SSL clients will by default try to reuse an available session, + SSL servers will by default agree to reuse sessions when clients ask to do so.</p> </section> diff --git a/lib/ssl/src/Makefile b/lib/ssl/src/Makefile index 7514ad2aa2..9c40d4ea53 100644 --- a/lib/ssl/src/Makefile +++ b/lib/ssl/src/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1999-2010. All Rights Reserved. +# Copyright Ericsson AB 1999-2011. All Rights Reserved. # # The contents of this file are subject to the Erlang Public License, # Version 1.1, (the "License"); you may not use this file except in @@ -43,10 +43,12 @@ MODULES= \ ssl_app \ ssl_broker \ ssl_broker_sup \ + ssl_dist_sup\ ssl_server \ ssl_sup \ ssl_prim \ inet_ssl_dist \ + inet_tls_dist \ ssl_certificate\ ssl_certificate_db\ ssl_cipher \ @@ -62,6 +64,7 @@ MODULES= \ ssl_ssl2 \ ssl_ssl3 \ ssl_tls1 \ + ssl_tls_dist_proxy INTERNAL_HRL_FILES = \ ssl_int.hrl ssl_broker_int.hrl ssl_debug.hrl \ diff --git a/lib/ssl/src/inet_ssl_dist.erl b/lib/ssl/src/inet_ssl_dist.erl index 6c0fbc0618..42a03a4879 100644 --- a/lib/ssl/src/inet_ssl_dist.erl +++ b/lib/ssl/src/inet_ssl_dist.erl @@ -31,9 +31,7 @@ -import(error_logger,[error_msg/2]). --include("net_address.hrl"). - - +-include_lib("kernel/include/net_address.hrl"). -define(to_port(Socket, Data, Opts), case ssl_prim:send(Socket, Data, Opts) of @@ -44,9 +42,8 @@ R end). - --include("dist.hrl"). --include("dist_util.hrl"). +-include_lib("kernel/include/dist.hrl"). +-include_lib("kernel/include/dist_util.hrl"). %% ------------------------------------------------------------- %% This function should return a valid childspec, so that diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl new file mode 100644 index 0000000000..f42c076460 --- /dev/null +++ b/lib/ssl/src/inet_tls_dist.erl @@ -0,0 +1,275 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% +-module(inet_tls_dist). + +-export([childspecs/0, listen/1, accept/1, accept_connection/5, + setup/5, close/1, select/1, is_node_name/1]). + +-include_lib("kernel/include/net_address.hrl"). +-include_lib("kernel/include/dist.hrl"). +-include_lib("kernel/include/dist_util.hrl"). + +childspecs() -> + {ok, [{ssl_dist_sup,{ssl_dist_sup, start_link, []}, + permanent, 2000, worker, [ssl_dist_sup]}]}. + +select(Node) -> + case split_node(atom_to_list(Node), $@, []) of + [_,_Host] -> + true; + _ -> + false + end. + +is_node_name(Node) when is_atom(Node) -> + select(Node); +is_node_name(_) -> + false. + +listen(Name) -> + ssl_tls_dist_proxy:listen(Name). + +accept(Listen) -> + ssl_tls_dist_proxy:accept(Listen). + +accept_connection(AcceptPid, Socket, MyNode, Allowed, SetupTime) -> + Kernel = self(), + spawn_link(fun() -> do_accept(Kernel, AcceptPid, Socket, + MyNode, Allowed, SetupTime) end). + +setup(Node, Type, MyNode, LongOrShortNames,SetupTime) -> + Kernel = self(), + spawn(fun() -> do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) end). + +do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> + [Name, Address] = splitnode(Node, LongOrShortNames), + case inet:getaddr(Address, inet) of + {ok, Ip} -> + Timer = dist_util:start_timer(SetupTime), + case erl_epmd:port_please(Name, Ip) of + {port, TcpPort, Version} -> + ?trace("port_please(~p) -> version ~p~n", + [Node,Version]), + dist_util:reset_timer(Timer), + case ssl_tls_dist_proxy:connect(Ip, TcpPort) of + {ok, Socket} -> + HSData = connect_hs_data(Kernel, Node, MyNode, Socket, + Timer, Version, Ip, TcpPort, Address, + Type), + dist_util:handshake_we_started(HSData); + _ -> + %% Other Node may have closed since + %% port_please ! + ?trace("other node (~p) " + "closed since port_please.~n", + [Node]), + ?shutdown(Node) + end; + _ -> + ?trace("port_please (~p) " + "failed.~n", [Node]), + ?shutdown(Node) + end; + _Other -> + ?trace("inet_getaddr(~p) " + "failed (~p).~n", [Node,Other]), + ?shutdown(Node) + end. + +close(Socket) -> + try + erlang:error(foo) + catch _:_ -> + io:format("close called ~p ~p~n",[Socket, erlang:get_stacktrace()]) + end, + gen_tcp:close(Socket), + ok. + +do_accept(Kernel, AcceptPid, Socket, MyNode, Allowed, SetupTime) -> + process_flag(priority, max), + receive + {AcceptPid, controller} -> + Timer = dist_util:start_timer(SetupTime), + case check_ip(Socket) of + true -> + HSData = accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed), + dist_util:handshake_other_started(HSData); + {false,IP} -> + error_logger:error_msg("** Connection attempt from " + "disallowed IP ~w ** ~n", [IP]), + ?shutdown(no_node) + end + end. +%% ------------------------------------------------------------ +%% Do only accept new connection attempts from nodes at our +%% own LAN, if the check_ip environment parameter is true. +%% ------------------------------------------------------------ +check_ip(Socket) -> + case application:get_env(check_ip) of + {ok, true} -> + case get_ifs(Socket) of + {ok, IFs, IP} -> + check_ip(IFs, IP); + _ -> + ?shutdown(no_node) + end; + _ -> + true + end. + +get_ifs(Socket) -> + case ssl_prim:peername(Socket) of + {ok, {IP, _}} -> + case ssl_prim:getif(Socket) of + {ok, IFs} -> {ok, IFs, IP}; + Error -> Error + end; + Error -> + Error + end. + +check_ip([{OwnIP, _, Netmask}|IFs], PeerIP) -> + case {mask(Netmask, PeerIP), mask(Netmask, OwnIP)} of + {M, M} -> true; + _ -> check_ip(IFs, PeerIP) + end; +check_ip([], PeerIP) -> + {false, PeerIP}. + +mask({M1,M2,M3,M4}, {IP1,IP2,IP3,IP4}) -> + {M1 band IP1, + M2 band IP2, + M3 band IP3, + M4 band IP4}; + +mask({M1,M2,M3,M4, M5, M6, M7, M8}, {IP1,IP2,IP3,IP4, IP5, IP6, IP7, IP8}) -> + {M1 band IP1, + M2 band IP2, + M3 band IP3, + M4 band IP4, + M5 band IP5, + M6 band IP6, + M7 band IP7, + M8 band IP8}. + + +%% If Node is illegal terminate the connection setup!! +splitnode(Node, LongOrShortNames) -> + case split_node(atom_to_list(Node), $@, []) of + [Name|Tail] when Tail =/= [] -> + Host = lists:append(Tail), + check_node(Name, Node, Host, LongOrShortNames); + [_] -> + error_logger:error_msg("** Nodename ~p illegal, no '@' character **~n", + [Node]), + ?shutdown(Node); + _ -> + error_logger:error_msg("** Nodename ~p illegal **~n", [Node]), + ?shutdown(Node) + end. + +check_node(Name, Node, Host, LongOrShortNames) -> + case split_node(Host, $., []) of + [_] when LongOrShortNames == longnames -> + error_logger:error_msg("** System running to use " + "fully qualified " + "hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown(Node); + [_, _ | _] when LongOrShortNames == shortnames -> + error_logger:error_msg("** System NOT running to use fully qualified " + "hostnames **~n" + "** Hostname ~s is illegal **~n", + [Host]), + ?shutdown(Node); + _ -> + [Name, Host] + end. + +split_node([Chr|T], Chr, Ack) -> + [lists:reverse(Ack)|split_node(T, Chr, [])]; +split_node([H|T], Chr, Ack) -> + split_node(T, Chr, [H|Ack]); +split_node([], _, Ack) -> + [lists:reverse(Ack)]. + +connect_hs_data(Kernel, Node, MyNode, Socket, Timer, Version, Ip, TcpPort, Address, Type) -> + common_hs_data(Kernel, MyNode, Socket, Timer, + #hs_data{other_node = Node, + other_version = Version, + f_address = + fun(_,_) -> + #net_address{address = {Ip,TcpPort}, + host = Address, + protocol = proxy, + family = inet} + end, + request_type = Type + }). + +accept_hs_data(Kernel, MyNode, Socket, Timer, Allowed) -> + common_hs_data(Kernel, MyNode, Socket, Timer, #hs_data{ + allowed = Allowed, + f_address = fun(S, N) -> + ssl_tls_dist_proxy:get_remote_id(S, N) + end + }). + +common_hs_data(Kernel, MyNode, Socket, Timer, HsData) -> + HsData#hs_data{ + kernel_pid = Kernel, + this_node = MyNode, + socket = Socket, + timer = Timer, + this_flags = 0, + f_send = + fun(S,D) -> + gen_tcp:send(S,D) + end, + f_recv = + fun(S,N,T) -> + gen_tcp:recv(S,N,T) + end, + f_setopts_pre_nodeup = + fun(S) -> + inet:setopts(S, [{active, false}, {packet, 4}]) + end, + f_setopts_post_nodeup = + fun(S) -> + inet:setopts(S, [{deliver, port},{active, true}]) + end, + f_getll = + fun(S) -> + inet:getll(S) + end, + mf_tick = + fun(S) -> + gen_tcp:send(S, <<>>) + end, + mf_getstat = + fun(S) -> + {ok, Stats} = inet:getstat(S, [recv_cnt, send_cnt, send_pend]), + R = proplists:get_value(recv_cnt, Stats, 0), + W = proplists:get_value(send_cnt, Stats, 0), + P = proplists:get_value(send_pend, Stats, 0), + {ok, R,W,P} + end}. diff --git a/lib/ssl/src/ssl.app.src b/lib/ssl/src/ssl.app.src index b9716786e6..afe19da900 100644 --- a/lib/ssl/src/ssl.app.src +++ b/lib/ssl/src/ssl.app.src @@ -8,6 +8,9 @@ ssl_broker, ssl_broker_sup, ssl_prim, + inet_tls_dist, + ssl_tls_dist_proxy, + ssl_dist_sup, inet_ssl_dist, ssl_tls1, ssl_ssl3, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index d1ec0c141e..57e0570bee 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -742,7 +742,8 @@ handle_options(Opts0, _Role) -> secure_renegotiate = handle_option(secure_renegotiate, Opts, false), renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT), debug = handle_option(debug, Opts, []), - hibernate_after = handle_option(hibernate_after, Opts, undefined) + hibernate_after = handle_option(hibernate_after, Opts, undefined), + erl_dist = handle_option(erl_dist, Opts, false) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -751,7 +752,7 @@ handle_options(Opts0, _Role) -> depth, cert, certfile, key, keyfile, password, cacerts, cacertfile, dh, dhfile, ciphers, debug, reuse_session, reuse_sessions, ssl_imp, - cb_info, renegotiate_at, secure_renegotiate, hibernate_after], + cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -862,6 +863,9 @@ validate_option(hibernate_after, undefined) -> undefined; validate_option(hibernate_after, Value) when is_integer(Value), Value >= 0 -> Value; +validate_option(erl_dist,Value) when Value == true; + Value == false -> + Value; validate_option(Opt, Value) -> throw({error, {eoptions, {Opt, Value}}}). diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index cec81d551b..79ee054200 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -1033,7 +1033,8 @@ code_change(_OldVsn, StateName, State, _Extra) -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_, _} = CbInfo, +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = false},_} = Opts, + User, {CbModule, _,_, _} = CbInfo, Timeout) -> try {ok, Pid} = ssl_connection_sup:start_child([Role, Host, Port, Socket, @@ -1044,9 +1045,26 @@ start_fsm(Role, Host, Port, Socket, Opts, User, {CbModule, _,_, _} = CbInfo, catch error:{badmatch, {error, _} = Error} -> Error + end; + +start_fsm(Role, Host, Port, Socket, {#ssl_options{erl_dist = true},_} = Opts, + User, {CbModule, _,_, _} = CbInfo, + Timeout) -> + try + {ok, Pid} = ssl_connection_sup:start_child_dist([Role, Host, Port, Socket, + Opts, User, CbInfo]), + {ok, SslSocket} = socket_control(Socket, Pid, CbModule), + ok = handshake(SslSocket, Timeout), + {ok, SslSocket} + catch + error:{badmatch, {error, _} = Error} -> + Error end. ssl_init(SslOpts, Role) -> + + init_manager_name(SslOpts#ssl_options.erl_dist), + {ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert} = init_certificates(SslOpts, Role), PrivateKey = init_private_key(CertDbHandle, SslOpts#ssl_options.key, SslOpts#ssl_options.keyfile, @@ -1054,6 +1072,10 @@ ssl_init(SslOpts, Role) -> DHParams = init_diffie_hellman(CertDbHandle, SslOpts#ssl_options.dh, SslOpts#ssl_options.dhfile, Role), {ok, CertDbRef, CertDbHandle, CacheHandle, OwnCert, PrivateKey, DHParams}. +init_manager_name(false) -> + put(ssl_manager, ssl_manager); +init_manager_name(true) -> + put(ssl_manager, ssl_manager_dist). init_certificates(#ssl_options{cacerts = CaCerts, cacertfile = CACertFile, diff --git a/lib/ssl/src/ssl_connection_sup.erl b/lib/ssl/src/ssl_connection_sup.erl index e9328d5f7c..78cfda5e63 100644 --- a/lib/ssl/src/ssl_connection_sup.erl +++ b/lib/ssl/src/ssl_connection_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -26,8 +26,8 @@ -behaviour(supervisor). %% API --export([start_link/0]). --export([start_child/1]). +-export([start_link/0, start_link_dist/0]). +-export([start_child/1, start_child_dist/1]). %% Supervisor callback -export([init/1]). @@ -38,9 +38,15 @@ start_link() -> supervisor:start_link({local, ?MODULE}, ?MODULE, []). +start_link_dist() -> + supervisor:start_link({local, ssl_connection_sup_dist}, ?MODULE, []). + start_child(Args) -> supervisor:start_child(?MODULE, Args). +start_child_dist(Args) -> + supervisor:start_child(ssl_connection_sup_dist, Args). + %%%========================================================================= %%% Supervisor callback %%%========================================================================= diff --git a/lib/ssl/src/ssl_dist_sup.erl b/lib/ssl/src/ssl_dist_sup.erl new file mode 100644 index 0000000000..c1912401d7 --- /dev/null +++ b/lib/ssl/src/ssl_dist_sup.erl @@ -0,0 +1,84 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +%% + +-module(ssl_dist_sup). + +-behaviour(supervisor). + +%% API +-export([start_link/0]). + +%% Supervisor callback +-export([init/1]). + +%%%========================================================================= +%%% API +%%%========================================================================= + +-spec start_link() -> {ok, pid()} | ignore | {error, term()}. + +start_link() -> + supervisor:start_link({local, ?MODULE}, ?MODULE, []). + +%%%========================================================================= +%%% Supervisor callback +%%%========================================================================= +-spec init([]) -> {ok, {SupFlags :: tuple(), [ChildSpec :: tuple()]}}. + +init([]) -> + SessionCertManager = session_and_cert_manager_child_spec(), + ConnetionManager = connection_manager_child_spec(), + ProxyServer = proxy_server_child_spec(), + + {ok, {{one_for_all, 10, 3600}, [SessionCertManager, ConnetionManager, + ProxyServer]}}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +session_and_cert_manager_child_spec() -> + Opts = ssl_sup:manager_opts(), + Name = ssl_manager_dist, + StartFunc = {ssl_manager, start_link_dist, [Opts]}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_manager], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +connection_manager_child_spec() -> + Name = ssl_connection_dist, + StartFunc = {ssl_connection_sup, start_link_dist, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_connection], + Type = supervisor, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + +proxy_server_child_spec() -> + Name = ssl_tls_dist_proxy, + StartFunc = {ssl_tls_dist_proxy, start_link, []}, + Restart = permanent, + Shutdown = 4000, + Modules = [ssl_tls_dist_proxy], + Type = worker, + {Name, StartFunc, Restart, Shutdown, Type, Modules}. + diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 6bf1edc452..483e06067c 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -98,10 +98,12 @@ renegotiate_at, secure_renegotiate, debug, - hibernate_after % undefined if not hibernating, + hibernate_after,% undefined if not hibernating, % or number of ms of inactivity % after which ssl_connection will % go into hibernation + %% This option should only be set to true by inet_tls_dist + erl_dist = false }). -record(socket_options, diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 725a085d1f..dcf310c535 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -27,7 +27,7 @@ -include("ssl_internal.hrl"). %% Internal application API --export([start_link/1, +-export([start_link/1, start_link_dist/1, connection_init/2, cache_pem_file/2, lookup_trusted_cert/4, issuer_candidate/2, client_session_id/4, server_session_id/4, @@ -66,10 +66,20 @@ %%-------------------------------------------------------------------- -spec start_link(list()) -> {ok, pid()} | ignore | {error, term()}. %% -%% Description: Starts the server +%% Description: Starts the ssl manager that takes care of sessions +%% and certificate caching. %%-------------------------------------------------------------------- start_link(Opts) -> - gen_server:start_link({local, ?MODULE}, ?MODULE, [Opts], []). + gen_server:start_link({local, ?MODULE}, ?MODULE, [?MODULE, Opts], []). + +%%-------------------------------------------------------------------- +-spec start_link_dist(list()) -> {ok, pid()} | ignore | {error, term()}. +%% +%% Description: Starts a special instance of the ssl manager to +%% be used by the erlang distribution. Note disables soft upgrade! +%%-------------------------------------------------------------------- +start_link_dist(Opts) -> + gen_server:start_link({local, ssl_manager_dist}, ?MODULE, [ssl_manager_dist, Opts], []). %%-------------------------------------------------------------------- -spec connection_init(string()| {der, list()}, client | server) -> @@ -166,7 +176,8 @@ invalidate_session(Port, Session) -> %% %% Description: Initiates the server %%-------------------------------------------------------------------- -init([Opts]) -> +init([Name, Opts]) -> + put(ssl_manager, Name), process_flag(trap_exit, true), CacheCb = proplists:get_value(session_cb, Opts, ssl_session_cache), SessionLifeTime = @@ -376,10 +387,10 @@ code_change(_OldVsn, State, _Extra) -> %%% Internal functions %%-------------------------------------------------------------------- call(Msg) -> - gen_server:call(?MODULE, {Msg, self()}, infinity). + gen_server:call(get(ssl_manager), {Msg, self()}, infinity). cast(Msg) -> - gen_server:cast(?MODULE, Msg). + gen_server:cast(get(ssl_manager), Msg). validate_session(Host, Port, Session, LifeTime) -> case ssl_session:valid_session(Session, LifeTime) of @@ -399,9 +410,10 @@ validate_session(Port, Session, LifeTime) -> start_session_validator(Cache, CacheCb, LifeTime) -> spawn_link(?MODULE, init_session_validator, - [[Cache, CacheCb, LifeTime]]). + [[get(ssl_manager), Cache, CacheCb, LifeTime]]). -init_session_validator([Cache, CacheCb, LifeTime]) -> +init_session_validator([SslManagerName, Cache, CacheCb, LifeTime]) -> + put(ssl_manager, SslManagerName), CacheCb:foldl(fun session_validation/2, LifeTime, Cache). diff --git a/lib/ssl/src/ssl_sup.erl b/lib/ssl/src/ssl_sup.erl index 316ed8a4e9..a008682b89 100644 --- a/lib/ssl/src/ssl_sup.erl +++ b/lib/ssl/src/ssl_sup.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2010. All Rights Reserved. +%% Copyright Ericsson AB 1998-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -24,7 +24,7 @@ -behaviour(supervisor). %% API --export([start_link/0]). +-export([start_link/0, manager_opts/0]). %% Supervisor callback -export([init/1]). @@ -62,6 +62,22 @@ init([]) -> {ok, {{one_for_all, 10, 3600}, [Child2, SessionCertManager, ConnetionManager]}}. + +manager_opts() -> + CbOpts = case application:get_env(ssl, session_cb) of + {ok, Cb} when is_atom(Cb) -> + InitArgs = session_cb_init_args(), + [{session_cb, Cb}, {session_cb_init_args, InitArgs}]; + _ -> + [] + end, + case application:get_env(ssl, session_lifetime) of + {ok, Time} when is_integer(Time) -> + [{session_lifetime, Time}| CbOpts]; + _ -> + CbOpts + end. + %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- @@ -86,21 +102,6 @@ connection_manager_child_spec() -> {Name, StartFunc, Restart, Shutdown, Type, Modules}. -manager_opts() -> - CbOpts = case application:get_env(ssl, session_cb) of - {ok, Cb} when is_atom(Cb) -> - InitArgs = session_cb_init_args(), - [{session_cb, Cb}, {session_cb_init_args, InitArgs}]; - _ -> - [] - end, - case application:get_env(ssl, session_lifetime) of - {ok, Time} when is_integer(Time) -> - [{session_lifetime, Time}| CbOpts]; - _ -> - CbOpts - end. - session_cb_init_args() -> case application:get_env(ssl, session_cb_init_args) of {ok, Args} when is_list(Args) -> diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl new file mode 100644 index 0000000000..1a998a0f34 --- /dev/null +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -0,0 +1,326 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(ssl_tls_dist_proxy). + + +-export([listen/1, accept/1, connect/2, get_remote_id/2]). +-export([init/1, start_link/0, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3, ssl_options/2]). + +-include_lib("kernel/include/net_address.hrl"). + +-record(state, + {listen, + accept_loop + }). + +-define(PPRE, 4). +-define(PPOST, 4). + + +%%==================================================================== +%% Internal application API +%%==================================================================== + +listen(Name) -> + gen_server:call(?MODULE, {listen, Name}, infinity). + +accept(Listen) -> + gen_server:call(?MODULE, {accept, Listen}, infinity). + +connect(Ip, Port) -> + gen_server:call(?MODULE, {connect, Ip, Port}, infinity). + +get_remote_id(Socket, Node) -> + gen_server:call(?MODULE, {get_remote_id, {Socket,Node}}, infinity). + +%%==================================================================== +%% gen_server callbacks +%%==================================================================== + +start_link() -> + gen_server:start_link({local, ?MODULE}, ?MODULE, [], []). + +init([]) -> + process_flag(priority, max), + {ok, #state{}}. + +handle_call({listen, Name}, _From, State) -> + case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}]) of + {ok, Socket} -> + {ok, World} = gen_tcp:listen(0, [{active, false}, binary, {packet,?PPRE}]), + TcpAddress = get_tcp_address(Socket), + WorldTcpAddress = get_tcp_address(World), + {_,Port} = WorldTcpAddress#net_address.address, + {ok, Creation} = erl_epmd:register_node(Name, Port), + {reply, {ok, {Socket, TcpAddress, Creation}}, + State#state{listen={Socket, World}}}; + Error -> + {reply, Error, State} + end; + +handle_call({accept, Listen}, {From, _}, State = #state{listen={_, World}}) -> + Self = self(), + ErtsPid = spawn_link(fun() -> accept_loop(Self, erts, Listen, From) end), + WorldPid = spawn_link(fun() -> accept_loop(Self, world, World, Listen) end), + {reply, ErtsPid, State#state{accept_loop={ErtsPid, WorldPid}}}; + +handle_call({connect, Ip, Port}, {From, _}, State) -> + Me = self(), + Pid = spawn_link(fun() -> setup_proxy(Ip, Port, Me) end), + receive + {Pid, go_ahead, LPort} -> + Res = {ok, Socket} = try_connect(LPort), + ok = gen_tcp:controlling_process(Socket, From), + flush_old_controller(From, Socket), + {reply, Res, State}; + {Pid, Error} -> + {reply, Error, State} + end; + +handle_call({get_remote_id, {Socket,_Node}}, _From, State) -> + Address = get_tcp_address(Socket), + {reply, Address, State}; + +handle_call(_What, _From, State) -> + {reply, ok, State}. + +handle_cast(_What, State) -> + {noreply, State}. + +handle_info(_What, State) -> + {noreply, State}. + +terminate(_Reason, _St) -> + ok. + +code_change(_OldVsn, St, _Extra) -> + {ok, St}. + +%%-------------------------------------------------------------------- +%%% Internal functions +%%-------------------------------------------------------------------- +get_tcp_address(Socket) -> + {ok, Address} = inet:sockname(Socket), + {ok, Host} = inet:gethostname(), + #net_address{ + address = Address, + host = Host, + protocol = proxy, + family = inet + }. + +accept_loop(Proxy, Type, Listen, Extra) -> + process_flag(priority, max), + case Type of + erts -> + case gen_tcp:accept(Listen) of + {ok, Socket} -> + Extra ! {accept,self(),Socket,inet,proxy}, + receive + {_Kernel, controller, Pid} -> + ok = gen_tcp:controlling_process(Socket, Pid), + flush_old_controller(Pid, Socket), + Pid ! {self(), controller}; + {_Kernel, unsupported_protocol} -> + exit(unsupported_protocol) + end; + Error -> + exit(Error) + end; + world -> + case gen_tcp:accept(Listen) of + {ok, Socket} -> + Opts = get_ssl_options(server), + case ssl:ssl_accept(Socket, Opts) of + {ok, SslSocket} -> + PairHandler = + spawn_link(fun() -> + setup_connection(SslSocket, Extra) + end), + ok = ssl:controlling_process(SslSocket, PairHandler), + flush_old_controller(PairHandler, SslSocket); + _ -> + gen_tcp:close(Socket) + end; + Error -> + exit(Error) + end + end, + accept_loop(Proxy, Type, Listen, Extra). + + +try_connect(Port) -> + case gen_tcp:connect({127,0,0,1}, Port, [{active, false}, {packet,?PPRE}]) of + R = {ok, _S} -> + R; + {error, _R} -> + try_connect(Port) + end. + +setup_proxy(Ip, Port, Parent) -> + process_flag(trap_exit, true), + Opts = get_ssl_options(client), + case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}] ++ Opts) of + {ok, World} -> + {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, binary, {packet,?PPRE}]), + #net_address{address={_,LPort}} = get_tcp_address(ErtsL), + Parent ! {self(), go_ahead, LPort}, + case gen_tcp:accept(ErtsL) of + {ok, Erts} -> + %% gen_tcp:close(ErtsL), + loop_conn_setup(World, Erts); + Err -> + Parent ! {self(), Err} + end; + Err -> + Parent ! {self(), Err} + end. + +setup_connection(World, ErtsListen) -> + process_flag(trap_exit, true), + TcpAddress = get_tcp_address(ErtsListen), + {_Addr,Port} = TcpAddress#net_address.address, + {ok, Erts} = gen_tcp:connect({127,0,0,1}, Port, [{active, true}, binary, {packet,?PPRE}]), + ssl:setopts(World, [{active,true}, {packet,?PPRE}]), + loop_conn_setup(World, Erts). + +loop_conn_setup(World, Erts) -> + receive + {ssl, World, Data = <<$a, _/binary>>} -> + gen_tcp:send(Erts, Data), + ssl:setopts(World, [{packet,?PPOST}]), + inet:setopts(Erts, [{packet,?PPOST}]), + loop_conn(World, Erts); + {tcp, Erts, Data = <<$a, _/binary>>} -> + ssl:send(World, Data), + ssl:setopts(World, [{packet,?PPOST}]), + inet:setopts(Erts, [{packet,?PPOST}]), + loop_conn(World, Erts); + {ssl, World, Data = <<_, _/binary>>} -> + gen_tcp:send(Erts, Data), + loop_conn_setup(World, Erts); + {tcp, Erts, Data = <<_, _/binary>>} -> + ssl:send(World, Data), + loop_conn_setup(World, Erts); + {ssl, World, Data} -> + gen_tcp:send(Erts, Data), + loop_conn_setup(World, Erts); + {tcp, Erts, Data} -> + ssl:send(World, Data), + loop_conn_setup(World, Erts) + end. + +loop_conn(World, Erts) -> + receive + {ssl, World, Data} -> + gen_tcp:send(Erts, Data), + loop_conn(World, Erts); + {tcp, Erts, Data} -> + ssl:send(World, Data), + loop_conn(World, Erts); + {tcp_closed, Erts} -> + ssl:close(World); + {ssl_closed, World} -> + gen_tcp:close(Erts) + end. + +get_ssl_options(Type) -> + case init:get_argument(ssl_dist_opt) of + {ok, Args} -> + [{erl_dist, true} | ssl_options(Type, Args)]; + _ -> + [{erl_dist, true}] + end. + +ssl_options(_,[]) -> + []; +ssl_options(server, [["client_" ++ _, _Value]|T]) -> + ssl_options(server,T); +ssl_options(client, [["server_" ++ _, _Value]|T]) -> + ssl_options(client,T); +ssl_options(server, [["server_certfile", Value]|T]) -> + [{certfile, Value} | ssl_options(server,T)]; +ssl_options(client, [["client_certfile", Value]|T]) -> + [{certfile, Value} | ssl_options(client,T)]; +ssl_options(server, [["server_cacertfile", Value]|T]) -> + [{cacertfile, Value} | ssl_options(server,T)]; +ssl_options(client, [["client_cacertfile", Value]|T]) -> + [{cacertfile, Value} | ssl_options(client,T)]; +ssl_options(server, [["server_keyfile", Value]|T]) -> + [{keyfile, Value} | ssl_options(server,T)]; +ssl_options(client, [["client_keyfile", Value]|T]) -> + [{keyfile, Value} | ssl_options(client,T)]; +ssl_options(server, [["server_password", Value]|T]) -> + [{password, Value} | ssl_options(server,T)]; +ssl_options(client, [["client_password", Value]|T]) -> + [{password, Value} | ssl_options(client,T)]; +ssl_options(server, [["server_verify", Value]|T]) -> + [{verify, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, [["client_verify", Value]|T]) -> + [{verify, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, [["server_reuse_sessions", Value]|T]) -> + [{reuse_sessions, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, [["client_reuse_sessions", Value]|T]) -> + [{reuse_sessions, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, [["server_secure_renegotiation", Value]|T]) -> + [{secure_renegotiation, atomize(Value)} | ssl_options(server,T)]; +ssl_options(client, [["client_secure_renegotiation", Value]|T]) -> + [{secure_renegotiation, atomize(Value)} | ssl_options(client,T)]; +ssl_options(server, [["server_depth", Value]|T]) -> + [{depth, list_to_integer(Value)} | ssl_options(server,T)]; +ssl_options(client, [["client_depth", Value]|T]) -> + [{depth, list_to_integer(Value)} | ssl_options(client,T)]; +ssl_options(server, [["server_hibernate_after", Value]|T]) -> + [{hibernate_after, list_to_integer(Value)} | ssl_options(server,T)]; +ssl_options(client, [["client_hibernate_after", Value]|T]) -> + [{hibernate_after, list_to_integer(Value)} | ssl_options(client,T)]; +ssl_options(server, [["server_ciphers", Value]|T]) -> + [{ciphers, Value} | ssl_options(server,T)]; +ssl_options(client, [["client_ciphers", Value]|T]) -> + [{ciphers, Value} | ssl_options(client,T)]; +ssl_options(server, [["server_dhfile", Value]|T]) -> + [{dhfile, Value} | ssl_options(server,T)]; +ssl_options(server, [["server_fail_if_no_peer_cert", Value]|T]) -> + [{fail_if_no_peer_cert, atomize(Value)} | ssl_options(server,T)]; +ssl_options(_,_) -> + exit(malformed_ssl_dist_opt). + +atomize(List) when is_list(List) -> + list_to_atom(List); +atomize(Atom) when is_atom(Atom) -> + Atom. + +flush_old_controller(Pid, Socket) -> + receive + {tcp, Socket, Data} -> + Pid ! {tcp, Socket, Data}, + flush_old_controller(Pid, Socket); + {tcp_closed, Socket} -> + Pid ! {tcp_closed, Socket}, + flush_old_controller(Pid, Socket); + {ssl, Socket, Data} -> + Pid ! {ssl, Socket, Data}, + flush_old_controller(Pid, Socket); + {ssl_closed, Socket} -> + Pid ! {ssl_closed, Socket}, + flush_old_controller(Pid, Socket) + after 0 -> + ok + end. diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 5be07cad2c..45a401aa68 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -41,6 +41,7 @@ MODULES = \ ssl_payload_SUITE \ ssl_to_openssl_SUITE \ ssl_session_cache_SUITE \ + ssl_dist_SUITE \ ssl_test_MACHINE \ old_ssl_active_SUITE \ old_ssl_active_once_SUITE \ diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl new file mode 100644 index 0000000000..7325e97ff5 --- /dev/null +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -0,0 +1,603 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(ssl_dist_SUITE). + +-include_lib("test_server/include/test_server.hrl"). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-define(DEFAULT_TIMETRAP_SECS, 240). + +-define(AWAIT_SLL_NODE_UP_TIMEOUT, 30000). + +-record(node_handle, + {connection_handler, + socket, + name, + nodename} + ). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [basic]. + +groups() -> + []. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +init_per_suite(Config) -> + try crypto:start() of + ok -> + add_ssl_opts_config(Config) + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(Config) -> + application:stop(crypto), + Config. + +init_per_testcase(Case, Config) when list(Config) -> + Dog = ?t:timetrap(?t:seconds(?DEFAULT_TIMETRAP_SECS)), + [{watchdog, Dog},{testcase, Case}|Config]. + +end_per_testcase(_Case, Config) when list(Config) -> + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Testcases %% +%% %% + +basic(doc) -> + ["Test that two nodes can connect via ssl distribution"]; +basic(suite) -> + []; +basic(Config) when is_list(Config) -> + NH1 = start_ssl_node(Config), + Node1 = NH1#node_handle.nodename, + NH2 = start_ssl_node(Config), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + [Node2] = apply_on_ssl_node(NH1, fun () -> nodes() end), + [Node1] = apply_on_ssl_node(NH2, fun () -> nodes() end), + + %% The test_server node has the same cookie as the ssl nodes + %% but it should not be able to communicate with the ssl nodes + %% via the erlang distribution. + pang = net_adm:ping(Node1), + pang = net_adm:ping(Node2), + + %% + %% Check that we are able to communicate over the erlang + %% distribution between the ssl nodes. + %% + Ref = make_ref(), + spawn(fun () -> + apply_on_ssl_node( + NH1, + fun () -> + tstsrvr_format("Hi from ~p!~n", [node()]), + send_to_tstcntrl({Ref, self()}), + receive + {From, ping} -> + tstsrvr_format("Received ping ~p!~n", [node()]), + From ! {self(), pong} + end + end) + end), + receive + {Ref, SslPid} -> + ok = apply_on_ssl_node( + NH2, + fun () -> + tstsrvr_format("Hi from ~p!~n", [node()]), + SslPid ! {self(), ping}, + receive + {SslPid, pong} -> + ok + end + end) + end, + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% %% +%% Internal functions %% +%% %% + +%% +%% ssl_node side api +%% + +tstsrvr_format(Fmt, ArgList) -> + send_to_tstsrvr({format, Fmt, ArgList}). + +send_to_tstcntrl(Message) -> + send_to_tstsrvr({message, Message}). + + +%% +%% test_server side api +%% + +apply_on_ssl_node(Node, M, F, A) when atom(M), atom(F), list(A) -> + Ref = make_ref(), + send_to_ssl_node(Node, {apply, self(), Ref, M, F, A}), + receive + {Ref, Result} -> + Result + end. + +apply_on_ssl_node(Node, Fun) when is_function(Fun, 0) -> + Ref = make_ref(), + send_to_ssl_node(Node, {apply, self(), Ref, Fun}), + receive + {Ref, Result} -> + Result + end. + +stop_ssl_node(#node_handle{connection_handler = Handler, + socket = Socket, + name = Name}) -> + ?t:format("Trying to stop ssl node ~s.~n", [Name]), + Mon = erlang:monitor(process, Handler), + unlink(Handler), + case gen_tcp:send(Socket, term_to_binary(stop)) of + ok -> + receive + {'DOWN', Mon, process, Handler, Reason} -> + case Reason of + normal -> ok; + _ -> exit(Reason) + end + end; + Error -> + erlang:demonitor(Mon, [flush]), + exit(Error) + end. + +start_ssl_node(Config) -> + start_ssl_node(Config, ""). + +start_ssl_node(Config, XArgs) -> + Name = mk_node_name(Config), + SSL = ?config(ssl_opts, Config), + SSLDistOpts = setup_dist_opts(Name, ?config(priv_dir, Config)), + start_ssl_node_raw(Name, SSL ++ " " ++ SSLDistOpts ++ XArgs). + +start_ssl_node_raw(Name, Args) -> + {ok, LSock} = gen_tcp:listen(0, + [binary, {packet, 4}, {active, false}]), + {ok, ListenPort} = inet:port(LSock), + CmdLine = mk_node_cmdline(ListenPort, Name, Args), + ?t:format("Attempting to start ssl node ~s: ~s~n", [Name, CmdLine]), + case open_port({spawn, CmdLine}, []) of + Port when port(Port) -> + unlink(Port), + erlang:port_close(Port), + case await_ssl_node_up(Name, LSock) of + #node_handle{} = NodeHandle -> + ?t:format("Ssl node ~s started.~n", [Name]), + NodeName = list_to_atom(Name ++ "@" ++ host_name()), + NodeHandle#node_handle{nodename = NodeName}; + Error -> + exit({failed_to_start_node, Name, Error}) + end; + Error -> + exit({failed_to_start_node, Name, Error}) + end. + +%% +%% command line creation +%% + +host_name() -> + [$@ | Host] = lists:dropwhile(fun ($@) -> false; (_) -> true end, + atom_to_list(node())), + Host. + +mk_node_name(Config) -> + {A, B, C} = erlang:now(), + Case = ?config(testcase, Config), + atom_to_list(?MODULE) + ++ "_" + ++ atom_to_list(Case) + ++ "_" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C). + +mk_node_cmdline(ListenPort, Name, Args) -> + Static = "-detached -noinput", + Pa = filename:dirname(code:which(?MODULE)), + Prog = case catch init:get_argument(progname) of + {ok,[[P]]} -> P; + _ -> exit(no_progname_argument_found) + end, + NameSw = case net_kernel:longnames() of + false -> "-sname "; + _ -> "-name " + end, + {ok, Pwd} = file:get_cwd(), + Prog ++ " " + ++ Static ++ " " + ++ NameSw ++ " " ++ Name ++ " " + ++ "-pa " ++ Pa ++ " " + ++ "-run application start crypto -run application start public_key " + ++ "-run " ++ atom_to_list(?MODULE) ++ " cnct2tstsrvr " + ++ host_name() ++ " " + ++ integer_to_list(ListenPort) ++ " " + ++ Args ++ " " + ++ "-env ERL_CRASH_DUMP " ++ Pwd ++ "/erl_crash_dump." ++ Name ++ " " + ++ "-setcookie " ++ atom_to_list(erlang:get_cookie()). + +%% +%% Connection handler test_server side +%% + +await_ssl_node_up(Name, LSock) -> + case gen_tcp:accept(LSock, ?AWAIT_SLL_NODE_UP_TIMEOUT) of + timeout -> + gen_tcp:close(LSock), + ?t:format("Timeout waiting for ssl node ~s to come up~n", + [Name]), + timeout; + {ok, Socket} -> + gen_tcp:close(LSock), + case gen_tcp:recv(Socket, 0) of + {ok, Bin} -> + check_ssl_node_up(Socket, Name, Bin); + {error, closed} -> + gen_tcp:close(Socket), + exit({lost_connection_with_ssl_node_before_up, Name}) + end; + {error, Error} -> + gen_tcp:close(LSock), + exit({accept_failed, Error}) + end. + +check_ssl_node_up(Socket, Name, Bin) -> + case catch binary_to_term(Bin) of + {'EXIT', _} -> + gen_tcp:close(Socket), + exit({bad_data_received_from_ssl_node, Name, Bin}); + {ssl_node_up, NodeName} -> + case list_to_atom(Name++"@"++host_name()) of + NodeName -> + Parent = self(), + Go = make_ref(), + %% Spawn connection handler on test server side + Pid = spawn_link( + fun () -> + receive Go -> ok end, + tstsrvr_con_loop(Name, Socket, Parent) + end), + ok = gen_tcp:controlling_process(Socket, Pid), + Pid ! Go, + #node_handle{connection_handler = Pid, + socket = Socket, + name = Name}; + _ -> + exit({unexpected_ssl_node_connected, NodeName}) + end; + Msg -> + exit({unexpected_msg_instead_of_ssl_node_up, Name, Msg}) + end. + +send_to_ssl_node(#node_handle{connection_handler = Hndlr}, Term) -> + Hndlr ! {relay_to_ssl_node, term_to_binary(Term)}, + ok. + +tstsrvr_con_loop(Name, Socket, Parent) -> + inet:setopts(Socket,[{active,once}]), + receive + {relay_to_ssl_node, Data} when is_binary(Data) -> + case gen_tcp:send(Socket, Data) of + ok -> + ok; + _Error -> + gen_tcp:close(Socket), + exit({failed_to_relay_data_to_ssl_node, Name, Data}) + end; + {tcp, Socket, Bin} -> + case catch binary_to_term(Bin) of + {'EXIT', _} -> + gen_tcp:close(Socket), + exit({bad_data_received_from_ssl_node, Name, Bin}); + {format, FmtStr, ArgList} -> + ?t:format(FmtStr, ArgList); + {message, Msg} -> + ?t:format("Got message ~p", [Msg]), + Parent ! Msg; + {apply_res, To, Ref, Res} -> + To ! {Ref, Res}; + bye -> + ?t:format("Ssl node ~s stopped.~n", [Name]), + gen_tcp:close(Socket), + exit(normal); + Unknown -> + exit({unexpected_message_from_ssl_node, Name, Unknown}) + end; + {tcp_closed, Socket} -> + gen_tcp:close(Socket), + exit({lost_connection_with_ssl_node, Name}) + end, + tstsrvr_con_loop(Name, Socket, Parent). + +%% +%% Connection handler ssl_node side +%% + +% cnct2tstsrvr() is called via command line arg -run ... +cnct2tstsrvr([Host, Port]) when list(Host), list(Port) -> + %% Spawn connection handler on ssl node side + ConnHandler + = spawn(fun () -> + case catch gen_tcp:connect(Host, + list_to_integer(Port), + [binary, + {packet, 4}, + {active, false}]) of + {ok, Socket} -> + notify_ssl_node_up(Socket), + ets:new(test_server_info, + [set, + public, + named_table, + {keypos, 1}]), + ets:insert(test_server_info, + {test_server_handler, self()}), + ssl_node_con_loop(Socket); + _Error -> + halt("Failed to connect to test server") + end + end), + spawn(fun () -> + Mon = erlang:monitor(process, ConnHandler), + receive + {'DOWN', Mon, process, ConnHandler, Reason} -> + receive after 1000 -> ok end, + halt("test server connection handler terminated: " + ++ + lists:flatten(io_lib:format("~p", [Reason]))) + end + end). + +notify_ssl_node_up(Socket) -> + case catch gen_tcp:send(Socket, + term_to_binary({ssl_node_up, node()})) of + ok -> ok; + _ -> halt("Failed to notify test server that I'm up") + end. + +send_to_tstsrvr(Term) -> + case catch ets:lookup_element(test_server_info, test_server_handler, 2) of + Hndlr when pid(Hndlr) -> + Hndlr ! {relay_to_test_server, term_to_binary(Term)}, ok; + _ -> + receive after 200 -> ok end, + send_to_tstsrvr(Term) + end. + +ssl_node_con_loop(Socket) -> + inet:setopts(Socket,[{active,once}]), + receive + {relay_to_test_server, Data} when is_binary(Data) -> + case gen_tcp:send(Socket, Data) of + ok -> + ok; + _Error -> + gen_tcp:close(Socket), + halt("Failed to relay data to test server") + end; + {tcp, Socket, Bin} -> + case catch binary_to_term(Bin) of + {'EXIT', _} -> + gen_tcp:close(Socket), + halt("test server sent me bad data"); + {apply, From, Ref, M, F, A} -> + spawn_link( + fun () -> + send_to_tstsrvr({apply_res, + From, + Ref, + (catch apply(M, F, A))}) + end); + {apply, From, Ref, Fun} -> + spawn_link(fun () -> + send_to_tstsrvr({apply_res, + From, + Ref, + (catch Fun())}) + end); + stop -> + gen_tcp:send(Socket, term_to_binary(bye)), + gen_tcp:close(Socket), + init:stop(), + receive after infinity -> ok end; + _Unknown -> + halt("test server sent me an unexpected message") + end; + {tcp_closed, Socket} -> + halt("Lost connection to test server") + end, + ssl_node_con_loop(Socket). + +%% +%% Setup ssl dist info +%% + +rand_bin(N) -> + rand_bin(N, []). + +rand_bin(0, Acc) -> + Acc; +rand_bin(N, Acc) -> + rand_bin(N-1, [random:uniform(256)-1|Acc]). + +make_randfile(Dir) -> + {ok, IoDev} = file:open(filename:join([Dir, "RAND"]), [write]), + {A, B, C} = erlang:now(), + random:seed(A, B, C), + ok = file:write(IoDev, rand_bin(1024)), + file:close(IoDev). + +append_files(FileNames, ResultFileName) -> + {ok, ResultFile} = file:open(ResultFileName, [write]), + do_append_files(FileNames, ResultFile). + +do_append_files([], RF) -> + ok = file:close(RF); +do_append_files([F|Fs], RF) -> + {ok, Data} = file:read_file(F), + ok = file:write(RF, Data), + do_append_files(Fs, RF). + +setup_dist_opts(Name, PrivDir) -> + NodeDir = filename:join([PrivDir, Name]), + RGenDir = filename:join([NodeDir, "rand_gen"]), + ok = file:make_dir(NodeDir), + ok = file:make_dir(RGenDir), + make_randfile(RGenDir), + make_certs:all(RGenDir, NodeDir), + SDir = filename:join([NodeDir, "server"]), + SC = filename:join([SDir, "cert.pem"]), + SK = filename:join([SDir, "key.pem"]), + SKC = filename:join([SDir, "keycert.pem"]), + append_files([SK, SC], SKC), + CDir = filename:join([NodeDir, "client"]), + CC = filename:join([CDir, "cert.pem"]), + CK = filename:join([CDir, "key.pem"]), + CKC = filename:join([CDir, "keycert.pem"]), + append_files([CK, CC], CKC), + "-proto_dist inet_tls " + ++ "-ssl_dist_opt server_certfile " ++ SKC ++ " " + ++ "-ssl_dist_opt client_certfile " ++ CKC ++ " ". + +%% +%% Start scripts etc... +%% + +add_ssl_opts_config(Config) -> + %% + %% Start with boot scripts if on an installed system; otherwise, + %% just point out ssl ebin with -pa. + %% + try + Dir = ?config(priv_dir, Config), + LibDir = code:lib_dir(), + Apps = application:which_applications(), + {value, {stdlib, _, STDL_VSN}} = lists:keysearch(stdlib, 1, Apps), + {value, {kernel, _, KRNL_VSN}} = lists:keysearch(kernel, 1, Apps), + StdlDir = filename:join([LibDir, "stdlib-" ++ STDL_VSN]), + KrnlDir = filename:join([LibDir, "kernel-" ++ KRNL_VSN]), + {ok, _} = file:read_file_info(StdlDir), + {ok, _} = file:read_file_info(KrnlDir), + SSL_VSN = vsn(ssl), + VSN_CRYPTO = vsn(crypto), + VSN_PKEY = vsn(public_key), + + SslDir = filename:join([LibDir, "ssl-" ++ SSL_VSN]), + {ok, _} = file:read_file_info(SslDir), + %% We are using an installed otp system, create the boot script. + Script = filename:join(Dir, atom_to_list(?MODULE)), + {ok, RelFile} = file:open(Script ++ ".rel", [write]), + io:format(RelFile, + "{release, ~n" + " {\"SSL distribution test release\", \"~s\"},~n" + " {erts, \"~s\"},~n" + " [{kernel, \"~s\"},~n" + " {stdlib, \"~s\"},~n" + " {crypto, \"~s\"},~n" + " {public_key, \"~s\"},~n" + " {ssl, \"~s\"}]}.~n", + [case catch erlang:system_info(otp_release) of + {'EXIT', _} -> "R11B"; + Rel -> Rel + end, + erlang:system_info(version), + KRNL_VSN, + STDL_VSN, + VSN_CRYPTO, + VSN_PKEY, + SSL_VSN]), + ok = file:close(RelFile), + ok = systools:make_script(Script, []), + [{ssl_opts, "-boot " ++ Script} | Config] + catch + _:_ -> + [{ssl_opts, "-pa " ++ filename:dirname(code:which(ssl))} + | add_comment_config( + "Bootscript wasn't used since the test wasn't run on an " + "installed OTP system.", + Config)] + end. + +%% +%% Add common comments to config +%% + +add_comment_config(Comment, []) -> + [{comment, Comment}]; +add_comment_config(Comment, [{comment, OldComment} | Cs]) -> + [{comment, Comment ++ " " ++ OldComment} | Cs]; +add_comment_config(Comment, [C|Cs]) -> + [C|add_comment_config(Comment, Cs)]. + +%% +%% Call when test case success +%% + +success(Config) -> + case lists:keysearch(comment, 1, Config) of + {value, {comment, _} = Res} -> Res; + _ -> ok + end. + +vsn(App) -> + application:start(App), + try + {value, + {ssl, + _, + VSN}} = lists:keysearch(App, + 1, + application:which_applications()), + VSN + after + application:stop(ssl) + end. diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index d9c645d787..9077e59fdc 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -224,7 +224,7 @@ version(File) -> MD5 :: binary(). md5(File) -> - case catch read_significant_chunks(File) of + case catch read_significant_chunks(File, md5_chunks()) of {ok, {Module, Chunks0}} -> Chunks = filter_funtab(Chunks0), {ok, {Module, erlang:md5([C || {_Id, C} <- Chunks])}}; @@ -395,7 +395,7 @@ strip_fils(Files) -> %% -> {ok, {Mod, FileName}} | {ok, {Mod, binary()}} | throw(Error) strip_file(File) -> - {ok, {Mod, Chunks}} = read_significant_chunks(File), + {ok, {Mod, Chunks}} = read_significant_chunks(File, significant_chunks()), {ok, Stripped0} = build_module(Chunks), Stripped = compress(Stripped0), case File of @@ -453,8 +453,8 @@ is_useless_chunk("CInf") -> true; is_useless_chunk(_) -> false. %% -> {ok, {Module, Chunks}} | throw(Error) -read_significant_chunks(File) -> - case read_chunk_data(File, significant_chunks(), [allow_missing_chunks]) of +read_significant_chunks(File, ChunkList) -> + case read_chunk_data(File, ChunkList, [allow_missing_chunks]) of {ok, {Module, Chunks0}} -> Mandatory = mandatory_chunks(), Chunks = filter_significant_chunks(Chunks0, Mandatory, File, Module), @@ -835,12 +835,15 @@ file_error(FileName, {error, Reason}) -> error(Reason) -> throw({error, ?MODULE, Reason}). - -%% The following chunks are significant when calculating the MD5 for a module, -%% and also the modules that must be retained when stripping a file. -%% They are listed in the order that they should be MD5:ed. +%% The following chunks must be kept when stripping a BEAM file. significant_chunks() -> + ["Line" | md5_chunks()]. + +%% The following chunks are significant when calculating the MD5 +%% for a module. They are listed in the order that they should be MD5:ed. + +md5_chunks() -> ["Atom", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT"]. %% The following chunks are mandatory in every Beam file. diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index febfdd6285..a920921a5e 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -797,7 +797,7 @@ appcall(App, M, F, Args) -> catch error:undef -> case erlang:get_stacktrace() of - [{M,F,Args}|_] -> + [{M,F,Args,_}|_] -> Arity = length(Args), io:format("Call to ~w:~w/~w in application ~w failed.\n", [M,F,Arity,App]); diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl index d804c1dee5..230a4a0612 100644 --- a/lib/stdlib/src/epp.erl +++ b/lib/stdlib/src/epp.erl @@ -684,7 +684,7 @@ scan_include_lib([{'(',_Llp},{string,_Lf,NewName0},{')',_Lrp},{dot,_Ld}], {error,_E1} -> case catch find_lib_dir(NewName) of {LibDir, Rest} when is_list(LibDir) -> - LibName = filename:join([LibDir | Rest]), + LibName = fname_join([LibDir | Rest]), case file:open(LibName, [read]) of {ok,NewF} -> ExtraPath = [filename:dirname(LibName)], @@ -1154,7 +1154,12 @@ expand_var1(NewName) -> [[$$ | Var] | Rest] = filename:split(NewName), Value = os:getenv(Var), true = Value =/= false, - {ok, filename:join([Value | Rest])}. + {ok, fname_join([Value | Rest])}. + +fname_join(["." | [_|_]=Rest]) -> + fname_join(Rest); +fname_join(Components) -> + filename:join(Components). %% The line only. (Other tokens may have the column and text as well...) loc_attr(Line) when is_integer(Line) -> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 515ea2ebb7..4f4fa16040 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -621,7 +621,7 @@ eval_generate(Term, _P, _Bs0, _Lf, _Ef, _CompFun, _Acc) -> erlang:raise(error, {bad_generator,Term}, stacktrace()). eval_b_generate(<<_/bitstring>>=Bin, P, Bs0, Lf, Ef, CompFun, Acc) -> - Mfun = fun(L, R, Bs) -> match1(L, R, Bs, Bs0) end, + Mfun = match_fun(Bs0), Efun = fun(Exp, Bs) -> expr(Exp, Bs, Lf, Ef, none) end, case eval_bits:bin_gen(P, Bin, new_bindings(), Bs0, Mfun, Efun) of {match, Rest, Bs1} -> @@ -1024,7 +1024,7 @@ match1({tuple,_,_}, _, _Bs, _BBs) -> throw(nomatch); match1({bin, _, Fs}, <<_/bitstring>>=B, Bs0, BBs) -> eval_bits:match_bits(Fs, B, Bs0, BBs, - fun(L, R, Bs) -> match1(L, R, Bs, BBs) end, + match_fun(BBs), fun(E, Bs) -> expr(E, Bs, none, none, none) end); match1({bin,_,_}, _, _Bs, _BBs) -> throw(nomatch); @@ -1053,6 +1053,12 @@ match1({op,Line,Op,L,R}, Term, Bs, BBs) -> match1(_, _, _Bs, _BBs) -> throw(invalid). +match_fun(BBs) -> + fun(match, {L,R,Bs}) -> match1(L, R, Bs, BBs); + (binding, {Name,Bs}) -> binding(Name, Bs); + (add_binding, {Name,Val,Bs}) -> add_binding(Name, Val, Bs) + end. + match_tuple([E|Es], Tuple, I, Bs0, BBs) -> {match,Bs} = match1(E, element(I, Tuple), Bs0, BBs), match_tuple(Es, Tuple, I+1, Bs, BBs); diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index 3073fc0fb5..cd3b531d10 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -264,7 +264,6 @@ bif(bitstring_to_list, 1) -> true; bif(byte_size, 1) -> true; bif(check_old_code, 1) -> true; bif(check_process_code, 2) -> true; -bif(concat_binary, 1) -> true; bif(date, 0) -> true; bif(delete_module, 1) -> true; bif(demonitor, 1) -> true; @@ -406,7 +405,6 @@ old_bif(bit_size, 1) -> true; old_bif(bitstring_to_list, 1) -> true; old_bif(byte_size, 1) -> true; old_bif(check_process_code, 2) -> true; -old_bif(concat_binary, 1) -> true; old_bif(date, 0) -> true; old_bif(delete_module, 1) -> true; old_bif(disconnect_node, 1) -> true; diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index cd1bacd2f5..ad49d89908 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -866,7 +866,7 @@ hidden_apply(App, M, F, Args) -> catch error:undef -> case erlang:get_stacktrace() of - [{M,F,Args} | _] -> + [{M,F,Args,_} | _] -> Arity = length(Args), Text = io_lib:format("Call to ~w:~w/~w in application ~w failed.\n", [M, F, Arity, App]), diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl index 2c7192a7e7..796c5b934d 100644 --- a/lib/stdlib/src/eval_bits.erl +++ b/lib/stdlib/src/eval_bits.erl @@ -31,8 +31,9 @@ %% @type evalfun(). A closure which evaluates an expression given an %% environment %% -%% @type matchfun(). A closure which performs a match given a value, a -%% pattern and an environment +%% @type matchfun(). A closure which depending on its first argument +%% can perform a match (given a value, a pattern and an environment), +%% lookup a variable in the bindings, or add a new binding %% %% @type field(). Represents a field in a "bin". @@ -144,7 +145,8 @@ eval_exp_field(Val, Size, Unit, binary, _, _) -> bin_gen({bin,_,Fs}, Bin, Bs0, BBs0, Mfun, Efun) -> bin_gen(Fs, Bin, Bs0, BBs0, Mfun, Efun, true). -bin_gen([F|Fs], Bin, Bs0, BBs0, Mfun, Efun, Flag) -> +bin_gen([F|Fs], Bin, Bs0, BBs0, Mfun, Efun, Flag) + when is_function(Mfun, 2), is_function(Efun, 2) -> case bin_gen_field(F, Bin, Bs0, BBs0, Mfun, Efun) of {match,Bs,BBs,Rest} -> bin_gen(Fs, Rest, Bs, BBs, Mfun, Efun, Flag); @@ -175,14 +177,14 @@ bin_gen_field({bin_element,Line,VE,Size0,Options0}, {Size1, [Type,{unit,Unit},Sign,Endian]} = make_bit_type(Line, Size0, Options0), V = erl_eval:partial_eval(VE), - match_check_size(Size1, BBs0), + match_check_size(Mfun, Size1, BBs0), {value, Size, _BBs} = Efun(Size1, BBs0), case catch get_value(Bin, Type, Size, Unit, Sign, Endian) of {Val,<<_/bitstring>>=Rest} -> NewV = coerce_to_float(V, Type), - case catch Mfun(NewV, Val, Bs0) of + case catch Mfun(match, {NewV,Val,Bs0}) of {match,Bs} -> - BBs = add_bin_binding(NewV, Bs, BBs0), + BBs = add_bin_binding(Mfun, NewV, Bs, BBs0), {match,Bs,BBs,Rest}; _ -> {nomatch,Rest} @@ -205,7 +207,8 @@ bin_gen_field({bin_element,Line,VE,Size0,Options0}, match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun, _) -> match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun). -match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun) -> +match_bits(Fs, Bin, Bs0, BBs, Mfun, Efun) + when is_function(Mfun, 2), is_function(Efun, 2) -> case catch match_bits_1(Fs, Bin, Bs0, BBs, Mfun, Efun) of {match,Bs} -> {match,Bs}; invalid -> throw(invalid); @@ -230,12 +233,12 @@ match_field_1({bin_element,Line,VE,Size0,Options0}, make_bit_type(Line, Size0, Options0), V = erl_eval:partial_eval(VE), Size2 = erl_eval:partial_eval(Size1), - match_check_size(Size2, BBs0), + match_check_size(Mfun, Size2, BBs0), {value, Size, _BBs} = Efun(Size2, BBs0), {Val,Rest} = get_value(Bin, Type, Size, Unit, Sign, Endian), NewV = coerce_to_float(V, Type), - {match,Bs} = Mfun(NewV, Val, Bs0), - BBs = add_bin_binding(NewV, Bs, BBs0), + {match,Bs} = Mfun(match, {NewV,Val,Bs0}), + BBs = add_bin_binding(Mfun, NewV, Bs, BBs0), {Bs,BBs,Rest}. %% Almost identical to the one in sys_pre_expand. @@ -249,12 +252,12 @@ coerce_to_float({integer,L,I}=E, float) -> coerce_to_float(E, _Type) -> E. -add_bin_binding({var,_,'_'}, _Bs, BBs) -> +add_bin_binding(_, {var,_,'_'}, _Bs, BBs) -> BBs; -add_bin_binding({var,_,Name}, Bs, BBs) -> - {value,Value} = erl_eval:binding(Name, Bs), - erl_eval:add_binding(Name, Value, BBs); -add_bin_binding(_, _Bs, BBs) -> +add_bin_binding(Mfun, {var,_,Name}, Bs, BBs) -> + {value,Value} = Mfun(binding, {Name,Bs}), + Mfun(add_binding, {Name,Value,BBs}); +add_bin_binding(_, _, _Bs, BBs) -> BBs. get_value(Bin, integer, Size, Unit, Sign, Endian) -> @@ -327,20 +330,20 @@ make_bit_type(_Line, Size, Type0) -> %Size evaluates to an integer or 'all' {error,Reason} -> error(Reason) end. -match_check_size({var,_,V}, Bs) -> - case erl_eval:binding(V, Bs) of +match_check_size(Mfun, {var,_,V}, Bs) -> + case Mfun(binding, {V,Bs}) of {value,_} -> ok; unbound -> throw(invalid) % or, rather, error({unbound,V}) end; -match_check_size({atom,_,all}, _Bs) -> +match_check_size(_, {atom,_,all}, _Bs) -> ok; -match_check_size({atom,_,undefined}, _Bs) -> +match_check_size(_, {atom,_,undefined}, _Bs) -> ok; -match_check_size({integer,_,_}, _Bs) -> +match_check_size(_, {integer,_,_}, _Bs) -> ok; -match_check_size({value,_,_}, _Bs) -> +match_check_size(_, {value,_,_}, _Bs) -> ok; %From the debugger. -match_check_size(_, _Bs) -> +match_check_size(_, _, _Bs) -> throw(invalid). %% error(Reason) -> exception thrown diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index 1c4a73680b..d1dd074fba 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -667,16 +667,16 @@ report_error(_Handler, {swapped,_,_}, _, _, _) -> ok; report_error(Handler, Reason, State, LastIn, SName) -> Reason1 = case Reason of - {'EXIT',{undef,[{M,F,A}|MFAs]}} -> + {'EXIT',{undef,[{M,F,A,L}|MFAs]}} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> - {undef,[{M,F,A}|MFAs]}; + {undef,[{M,F,A,L}|MFAs]}; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; {'EXIT',Why} -> diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index f2f1365d3d..ea21136bdb 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -561,16 +561,16 @@ terminate(Reason, Name, Msg, Mod, StateName, StateData, Debug) -> error_info(Reason, Name, Msg, StateName, StateData, Debug) -> Reason1 = case Reason of - {undef,[{M,F,A}|MFAs]} -> + {undef,[{M,F,A,L}|MFAs]} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> Reason; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; _ -> diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index 09d94a9c40..b8ea3a4de2 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -729,16 +729,16 @@ error_info(_Reason, application_controller, _Msg, _State, _Debug) -> error_info(Reason, Name, Msg, State, Debug) -> Reason1 = case Reason of - {undef,[{M,F,A}|MFAs]} -> + {undef,[{M,F,A,L}|MFAs]} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> Reason; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; _ -> diff --git a/lib/stdlib/src/lib.erl b/lib/stdlib/src/lib.erl index c303ae60b5..314fd60903 100644 --- a/lib/stdlib/src/lib.erl +++ b/lib/stdlib/src/lib.erl @@ -173,12 +173,12 @@ format_fun(Fun) when is_function(Fun) -> analyze_exception(error, Term, Stack) -> case {is_stacktrace(Stack), Stack, Term} of - {true, [{_M,_F,As}=MFA|MFAs], function_clause} when is_list(As) -> - {Term,[MFA],MFAs}; - {true, [{shell,F,A}], function_clause} when is_integer(A) -> + {true, [{_,_,As,_}=MFAL|MFAs], function_clause} when is_list(As) -> + {Term,[MFAL],MFAs}; + {true, [{shell,F,A,_}], function_clause} when is_integer(A) -> {Term, [{F,A}], []}; - {true, [{_M,_F,_AorAs}=MFA|MFAs], undef} -> - {Term,[MFA],MFAs}; + {true, [{_,_,_,_}=MFAL|MFAs], undef} -> + {Term,[MFAL],MFAs}; {true, _, _} -> {Term,[],Stack}; {false, _, _} -> @@ -194,9 +194,11 @@ analyze_exception(_Class, Term, Stack) -> is_stacktrace([]) -> true; -is_stacktrace([{M,F,A}|Fs]) when is_atom(M), is_atom(F), is_integer(A) -> +is_stacktrace([{M,F,A,I}|Fs]) + when is_atom(M), is_atom(F), is_integer(A), is_list(I) -> is_stacktrace(Fs); -is_stacktrace([{M,F,As}|Fs]) when is_atom(M), is_atom(F), length(As) >= 0 -> +is_stacktrace([{M,F,As,I}|Fs]) + when is_atom(M), is_atom(F), length(As) >= 0, is_list(I) -> is_stacktrace(Fs); is_stacktrace(_) -> false. @@ -225,9 +227,9 @@ explain_reason(function_clause, error, [{F,A}], _PF, _S) -> %% Shell commands FAs = io_lib:fwrite(<<"~w/~w">>, [F, A]), [<<"no function clause matching call to ">> | FAs]; -explain_reason(function_clause, error=Cl, [{M,F,As}], PF, S) -> +explain_reason(function_clause, error=Cl, [{M,F,As,Loc}], PF, S) -> Str = <<"no function clause matching ">>, - format_errstr_call(Str, Cl, {M,F}, As, PF, S); + [format_errstr_call(Str, Cl, {M,F}, As, PF, S),$\s|location(Loc)]; explain_reason(if_clause, error, [], _PF, _S) -> <<"no true branch found when evaluating an if expression">>; explain_reason(noproc, error, [], _PF, _S) -> @@ -242,11 +244,11 @@ explain_reason({try_clause,V}, error=Cl, [], PF, S) -> %% "there is no try clause with a true guard sequence and a %% pattern matching..." format_value(V, <<"no try clause matching ">>, Cl, PF, S); -explain_reason(undef, error, [{M,F,A}], _PF, _S) -> +explain_reason(undef, error, [{M,F,A,_}], _PF, _S) -> %% Only the arity is displayed, not the arguments, if there are any. io_lib:fwrite(<<"undefined function ~s">>, [mfa_to_string(M, F, n_args(A))]); -explain_reason({shell_undef,F,A}, error, [], _PF, _S) -> +explain_reason({shell_undef,F,A,_}, error, [], _PF, _S) -> %% Give nicer reports for undefined shell functions %% (but not when the user actively calls shell_default:F(...)). io_lib:fwrite(<<"undefined shell command ~s/~w">>, [F, n_args(A)]); @@ -292,17 +294,19 @@ argss(I) -> io_lib:fwrite(<<"~w arguments">>, [I]). format_stacktrace1(S0, Stack0, PF, SF) -> - Stack1 = lists:dropwhile(fun({M,F,A}) -> SF(M, F, A) + Stack1 = lists:dropwhile(fun({M,F,A,_}) -> SF(M, F, A) end, lists:reverse(Stack0)), S = [" " | S0], Stack = lists:reverse(Stack1), format_stacktrace2(S, Stack, 1, PF). -format_stacktrace2(S, [{M,F,A}|Fs], N, PF) when is_integer(A) -> - [io_lib:fwrite(<<"~s~s ~s">>, - [sep(N, S), origin(N, M, F, A), mfa_to_string(M, F, A)]) +format_stacktrace2(S, [{M,F,A,L}|Fs], N, PF) when is_integer(A) -> + [io_lib:fwrite(<<"~s~s ~s ~s">>, + [sep(N, S), origin(N, M, F, A), + mfa_to_string(M, F, A), + location(L)]) | format_stacktrace2(S, Fs, N + 1, PF)]; -format_stacktrace2(S, [{M,F,As}|Fs], N, PF) when is_list(As) -> +format_stacktrace2(S, [{M,F,As,_}|Fs], N, PF) when is_list(As) -> A = length(As), CalledAs = [S,<<" called as ">>], C = format_call("", CalledAs, {M,F}, As, PF), @@ -313,6 +317,16 @@ format_stacktrace2(S, [{M,F,As}|Fs], N, PF) when is_list(As) -> format_stacktrace2(_S, [], _N, _PF) -> "". +location(L) -> + File = proplists:get_value(file, L), + Line = proplists:get_value(line, L), + if + File =/= undefined, Line =/= undefined -> + io_lib:format("(~s, line ~w)", [File, Line]); + true -> + "" + end. + sep(1, S) -> S; sep(_, S) -> [$\n | S]. diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 5129ba5074..c1285dab60 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -330,22 +330,22 @@ obsolete_1(erlang, fault, 2) -> obsolete_1(file, rawopen, 2) -> {removed, "deprecated (will be removed in R13B); use file:open/2 with the raw option"}; -obsolete_1(http, request, 1) -> {deprecated,{httpc,request,1},"R15B"}; -obsolete_1(http, request, 2) -> {deprecated,{httpc,request,2},"R15B"}; -obsolete_1(http, request, 4) -> {deprecated,{httpc,request,4},"R15B"}; -obsolete_1(http, request, 5) -> {deprecated,{httpc,request,5},"R15B"}; -obsolete_1(http, cancel_request, 1) -> {deprecated,{httpc,cancel_request,1},"R15B"}; -obsolete_1(http, cancel_request, 2) -> {deprecated,{httpc,cancel_request,2},"R15B"}; -obsolete_1(http, set_option, 2) -> {deprecated,{httpc,set_option,2},"R15B"}; -obsolete_1(http, set_option, 3) -> {deprecated,{httpc,set_option,3},"R15B"}; -obsolete_1(http, set_options, 1) -> {deprecated,{httpc,set_options,1},"R15B"}; -obsolete_1(http, set_options, 2) -> {deprecated,{httpc,set_options,2},"R15B"}; -obsolete_1(http, verify_cookies, 2) -> {deprecated,{httpc,verify_cookies,2},"R15B"}; -obsolete_1(http, verify_cookies, 3) -> {deprecated,{httpc,verify_cookies,3},"R15B"}; -obsolete_1(http, cookie_header, 1) -> {deprecated,{httpc,cookie_header,1},"R15B"}; -obsolete_1(http, cookie_header, 2) -> {deprecated,{httpc,cookie_header,2},"R15B"}; -obsolete_1(http, stream_next, 1) -> {deprecated,{httpc,stream_next,1},"R15B"}; -obsolete_1(http, default_profile, 0) -> {deprecated,{httpc,default_profile,0},"R15B"}; +obsolete_1(http, request, 1) -> {removed,{httpc,request,1},"R15B"}; +obsolete_1(http, request, 2) -> {removed,{httpc,request,2},"R15B"}; +obsolete_1(http, request, 4) -> {removed,{httpc,request,4},"R15B"}; +obsolete_1(http, request, 5) -> {removed,{httpc,request,5},"R15B"}; +obsolete_1(http, cancel_request, 1) -> {removed,{httpc,cancel_request,1},"R15B"}; +obsolete_1(http, cancel_request, 2) -> {removed,{httpc,cancel_request,2},"R15B"}; +obsolete_1(http, set_option, 2) -> {removed,{httpc,set_option,2},"R15B"}; +obsolete_1(http, set_option, 3) -> {removed,{httpc,set_option,3},"R15B"}; +obsolete_1(http, set_options, 1) -> {removed,{httpc,set_options,1},"R15B"}; +obsolete_1(http, set_options, 2) -> {removed,{httpc,set_options,2},"R15B"}; +obsolete_1(http, verify_cookies, 2) -> {removed,{httpc,store_cookies,2},"R15B"}; +obsolete_1(http, verify_cookies, 3) -> {removed,{httpc,store_cookies,3},"R15B"}; +obsolete_1(http, cookie_header, 1) -> {removed,{httpc,cookie_header,1},"R15B"}; +obsolete_1(http, cookie_header, 2) -> {removed,{httpc,cookie_header,2},"R15B"}; +obsolete_1(http, stream_next, 1) -> {removed,{httpc,stream_next,1},"R15B"}; +obsolete_1(http, default_profile, 0) -> {removed,{httpc,default_profile,0},"R15B"}; obsolete_1(httpd, start, 0) -> {removed,{inets,start,[2,3]},"R14B"}; obsolete_1(httpd, start, 1) -> {removed,{inets,start,[2,3]},"R14B"}; @@ -449,7 +449,7 @@ obsolete_1(ssl_pkix, decode_cert, A) when A =:= 1; A =:= 2 -> %% Added in R13B04. obsolete_1(erlang, concat_binary, 1) -> - {deprecated,{erlang,list_to_binary,1},"R15B"}; + {removed,{erlang,list_to_binary,1},"R15B"}; %% Added in R14A. obsolete_1(ssl, peercert, 2) -> @@ -469,6 +469,10 @@ obsolete_1(docb_transform, _, _) -> obsolete_1(docb_xml_check, _, _) -> {deprecated,"the DocBuilder application is deprecated (will be removed in R15B)"}; +%% Added in R15B +obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver -> + {deprecated,"deprecated (will be removed in R16A); has no effect as drivers are no longer used."}; + obsolete_1(_, _, _) -> no. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 5ca04ff023..f5e180b4bd 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -123,7 +123,7 @@ -record(setup, {parent}). --define(THROWN_ERROR, {?MODULE, throw_error, _}). +-define(THROWN_ERROR, {?MODULE, throw_error, _, _}). -export_type([query_handle/0]). @@ -3701,7 +3701,8 @@ lookup_join(F1, C1, LuF, C2, Rev) -> maybe_error_logger(allowed, _) -> ok; maybe_error_logger(Name, Why) -> - [_, _, {?MODULE,maybe_error_logger,_} | Stacktrace] = expand_stacktrace(), + [_, _, {?MODULE,maybe_error_logger,_,_} | Stacktrace] = + expand_stacktrace(), Trimmer = fun(M, _F, _A) -> M =:= erl_eval end, Formater = fun(Term, I) -> io_lib:print(Term, I, 80, -1) end, X = lib:format_stacktrace(1, Stacktrace, Trimmer, Formater), @@ -3720,7 +3721,7 @@ expand_stacktrace() -> expand_stacktrace(D) -> _ = erlang:system_flag(backtrace_depth, D), {'EXIT', {foo, Stacktrace}} = (catch erlang:error(foo)), - L = lists:takewhile(fun({M,_,_}) -> M =/= ?MODULE + L = lists:takewhile(fun({M,_,_,_}) -> M =/= ?MODULE end, lists:reverse(Stacktrace)), if length(L) < 3 andalso length(Stacktrace) =:= D -> diff --git a/lib/stdlib/src/re.erl b/lib/stdlib/src/re.erl index e08258a535..99bcbd722e 100644 --- a/lib/stdlib/src/re.erl +++ b/lib/stdlib/src/re.erl @@ -573,10 +573,10 @@ ucompile(RE,Options) -> re:compile(unicode:characters_to_binary(RE,unicode),Options) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [RE,Options])), - erlang:raise(error,AnyError,[{Mod,compile,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,compile,L,Loc}|Rest]) end. @@ -585,10 +585,10 @@ urun(Subject,RE,Options) -> urun2(Subject,RE,Options) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [Subject,RE,Options])), - erlang:raise(error,AnyError,[{Mod,run,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,run,L,Loc}|Rest]) end. urun2(Subject0,RE0,Options0) -> @@ -625,20 +625,20 @@ grun(Subject,RE,{Options,NeedClean}) -> grun2(Subject,RE,{Options,NeedClean}) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [Subject,RE,Options])), - erlang:raise(error,AnyError,[{Mod,run,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,run,L,Loc}|Rest]) end; grun(Subject,RE,{Options,NeedClean,OrigRE}) -> try grun2(Subject,RE,{Options,NeedClean}) catch error:AnyError -> - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,Loc}|Rest]}} = (catch erlang:error(new_stacktrace, [Subject,OrigRE,Options])), - erlang:raise(error,AnyError,[{Mod,run,L}|Rest]) + erlang:raise(error,AnyError,[{Mod,run,L,Loc}|Rest]) end. grun2(Subject,RE,{Options,NeedClean}) -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index e3e23e09bc..964697cae6 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1088,7 +1088,7 @@ shell_default(F,As,Bs) -> end. shell_undef(F,A) -> - erlang:error({shell_undef,F,A}). + erlang:error({shell_undef,F,A,[]}). local_func_handler(Shell, RT, Ef) -> H = fun(Lf) -> diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index dc31647eb5..36cc7f4f4b 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -661,6 +661,9 @@ do_restart(_, normal, Child, State) -> do_restart(_, shutdown, Child, State) -> NState = state_del_child(Child, State), {ok, NState}; +do_restart(_, {shutdown, _Term}, Child, State) -> + NState = state_del_child(Child, State), + {ok, NState}; do_restart(transient, Reason, Child, State) -> report_error(child_terminated, Reason, Child, State#state.name), restart(Child, State); diff --git a/lib/stdlib/src/unicode.erl b/lib/stdlib/src/unicode.erl index a5d9965ca2..e9b90befe6 100644 --- a/lib/stdlib/src/unicode.erl +++ b/lib/stdlib/src/unicode.erl @@ -73,7 +73,7 @@ characters_to_list_int(ML, Encoding) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,Encoding])), erlang:raise(error,TheError,[{Mod,characters_to_list,L}|Rest]) @@ -109,7 +109,7 @@ characters_to_binary(ML) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML])), erlang:raise(error,TheError,[{Mod,characters_to_binary,L}|Rest]) @@ -127,7 +127,7 @@ characters_to_binary_int(ML,InEncoding) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,InEncoding])), erlang:raise(error,TheError,[{Mod,characters_to_binary,L}|Rest]) @@ -159,7 +159,7 @@ characters_to_binary(ML, latin1, Uni) when is_binary(ML) and ((Uni =:= utf8) or _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,latin1,Uni])), erlang:raise(error,TheError, @@ -181,7 +181,7 @@ characters_to_binary(ML,Uni,latin1) when is_binary(ML) and ((Uni =:= utf8) or _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,Uni,latin1])), erlang:raise(error,TheError, @@ -200,7 +200,7 @@ characters_to_binary(ML, InEncoding, OutEncoding) -> _ -> badarg end, - {'EXIT',{new_stacktrace,[{Mod,_,L}|Rest]}} = + {'EXIT',{new_stacktrace,[{Mod,_,L,_}|Rest]}} = (catch erlang:error(new_stacktrace, [ML,InEncoding,OutEncoding])), erlang:raise(error,TheError,[{Mod,characters_to_binary,L}|Rest]) diff --git a/lib/stdlib/test/beam_lib_SUITE.erl b/lib/stdlib/test/beam_lib_SUITE.erl index 91fff3cee4..b7fb1f618f 100644 --- a/lib/stdlib/test/beam_lib_SUITE.erl +++ b/lib/stdlib/test/beam_lib_SUITE.erl @@ -330,6 +330,7 @@ strip(Conf) when is_list(Conf) -> ?line {Source2D1, BeamFile2D1} = make_beam(PrivDir, simple2, concat), ?line {Source3D1, BeamFile3D1} = make_beam(PrivDir, make_fun, make_fun), ?line {Source4D1, BeamFile4D1} = make_beam(PrivDir, constant, constant), + ?line {Source5D1, BeamFile5D1} = make_beam(PrivDir, lines, lines), ?line NoOfTables = length(ets:all()), ?line P0 = pps(), @@ -360,13 +361,25 @@ strip(Conf) when is_list(Conf) -> ?line {module, make_fun} = code:load_abs(filename:rootname(BeamFile3D1)), ?line {module, constant} = code:load_abs(filename:rootname(BeamFile4D1)), + %% check that line number information is still present after stripping + ?line {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)), + ?line {'EXIT',{badarith,[{lines,t,1,Info}|_]}} = + (catch lines:t(atom)), + ?line true = code:delete(lines), + ?line false = code:purge(lines), + ?line {ok, {lines,BeamFile5D1}} = beam_lib:strip(BeamFile5D1), + ?line {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)), + ?line {'EXIT',{badarith,[{lines,t,1,Info}|_]}} = + (catch lines:t(atom)), + ?line true = (P0 == pps()), ?line NoOfTables = length(ets:all()), ?line delete_files([SourceD1, BeamFileD1, Source2D1, BeamFile2D1, Source3D1, BeamFile3D1, - Source4D1, BeamFile4D1]), + Source4D1, BeamFile4D1, + Source5D1, BeamFile5D1]), ok. @@ -773,6 +786,12 @@ simple_file(File, Module, constant2) -> "t(A) -> " " {a,b,[2,3],x,y}. "]), ok = file:write_file(File, B); +simple_file(File, Module, lines) -> + B = list_to_binary(["-module(", atom_to_list(Module), ").\n" + "-export([t/1]).\n" + "t(A) ->\n" + " A+1.\n"]), + ok = file:write_file(File, B); simple_file(File, Module, F) -> B = list_to_binary(["-module(", atom_to_list(Module), "). " "-export([t/0]). " diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index 22a9d4a7ff..b569ed9003 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -1857,9 +1857,9 @@ fixtable(Config, Version) when is_list(Config) -> ?line {ok, _} = dets:open_file(T, Args), %% badarg - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = + ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = (catch dets:safe_fixtable(no_table,true)), - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[T,undefined]}|_]}} = + ?line {'EXIT', {badarg, [{dets,safe_fixtable,[T,undefined],_}|_]}} = (catch dets:safe_fixtable(T,undefined)), %% The table is not allowed to grow while the elements are inserted: @@ -1940,21 +1940,21 @@ match(Config, Version) -> %% match, badarg MSpec = [{'_',[],['$_']}], - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = + ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = (catch dets:match(no_table, '_')), - ?line {'EXIT', {badarg, [{dets,match,[T,'_',not_a_number]}|_]}} = + ?line {'EXIT', {badarg, [{dets,match,[T,'_',not_a_number],_}|_]}} = (catch dets:match(T, '_', not_a_number)), ?line {EC1, _} = dets:select(T, MSpec, 1), - ?line {'EXIT', {badarg, [{dets,match,[EC1]}|_]}} = + ?line {'EXIT', {badarg, [{dets,match,[EC1],_}|_]}} = (catch dets:match(EC1)), %% match_object, badarg - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = + ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = (catch dets:match_object(no_table, '_')), - ?line {'EXIT', {badarg, [{dets,match_object,[T,'_',not_a_number]}|_]}} = + ?line {'EXIT', {badarg, [{dets,match_object,[T,'_',not_a_number],_}|_]}} = (catch dets:match_object(T, '_', not_a_number)), ?line {EC2, _} = dets:select(T, MSpec, 1), - ?line {'EXIT', {badarg, [{dets,match_object,[EC2]}|_]}} = + ?line {'EXIT', {badarg, [{dets,match_object,[EC2],_}|_]}} = (catch dets:match_object(EC2)), dets:safe_fixtable(T, true), @@ -2118,16 +2118,16 @@ select(Config, Version) -> %% badarg MSpec = [{'_',[],['$_']}], - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = + ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = (catch dets:select(no_table, MSpec)), - ?line {'EXIT', {badarg, [{dets,select,[T,<<17>>]}|_]}} = + ?line {'EXIT', {badarg, [{dets,select,[T,<<17>>],_}|_]}} = (catch dets:select(T, <<17>>)), - ?line {'EXIT', {badarg, [{dets,select,[T,[]]}|_]}} = + ?line {'EXIT', {badarg, [{dets,select,[T,[]],_}|_]}} = (catch dets:select(T, [])), - ?line {'EXIT', {badarg, [{dets,select,[T,MSpec,not_a_number]}|_]}} = + ?line {'EXIT', {badarg, [{dets,select,[T,MSpec,not_a_number],_}|_]}} = (catch dets:select(T, MSpec, not_a_number)), ?line {EC, _} = dets:match(T, '_', 1), - ?line {'EXIT', {badarg, [{dets,select,[EC]}|_]}} = + ?line {'EXIT', {badarg, [{dets,select,[EC],_}|_]}} = (catch dets:select(EC)), AllSpec = [{'_',[],['$_']}], @@ -2210,7 +2210,7 @@ update_counter(Config) when is_list(Config) -> ?line file:delete(Fname), P0 = pps(), - ?line {'EXIT', {badarg, [{dets,update_counter,[no_table,1,1]}|_]}} = + ?line {'EXIT', {badarg, [{dets,update_counter,[no_table,1,1],_}|_]}} = (catch dets:update_counter(no_table, 1, 1)), Args = [{file,Fname},{keypos,2}], @@ -2254,65 +2254,66 @@ badarg(Config) when is_list(Config) -> %% badargs are tested in match, select and fixtable too. %% open - ?line {'EXIT', {badarg, [{dets,open_file,[{a,tuple},[]]}|_]}} = + ?line {'EXIT', {badarg, [{dets,open_file,[{a,tuple},[]],_}|_]}} = (catch dets:open_file({a,tuple},[])), - ?line {'EXIT', {badarg, [{dets,open_file,[{a,tuple}]}|_]}} = + ?line {'EXIT', {badarg, [{dets,open_file,[{a,tuple}],_}|_]}} = (catch dets:open_file({a,tuple})), - ?line {'EXIT', {badarg, [{dets,open_file,[file,[foo]]}|_]}} = + ?line {'EXIT', {badarg, [{dets,open_file,[file,[foo]],_}|_]}} = (catch dets:open_file(file,[foo])), - ?line {'EXIT', {badarg,[{dets,open_file,[{hej,san},[{type,set}|3]]}|_]}} = + ?line {'EXIT', {badarg,[{dets,open_file, + [{hej,san},[{type,set}|3]],_}|_]}} = (catch dets:open_file({hej,san},[{type,set}|3])), %% insert - ?line {'EXIT', {badarg, [{dets,insert,[no_table,{1,2}]}|_]}} = + ?line {'EXIT', {badarg, [{dets,insert,[no_table,{1,2}],_}|_]}} = (catch dets:insert(no_table, {1,2})), - ?line {'EXIT', {badarg, [{dets,insert,[no_table,[{1,2}]]}|_]}} = + ?line {'EXIT', {badarg, [{dets,insert,[no_table,[{1,2}]],_}|_]}} = (catch dets:insert(no_table, [{1,2}])), - ?line {'EXIT', {badarg, [{dets,insert,[T,{1,2}]}|_]}} = + ?line {'EXIT', {badarg, [{dets,insert,[T,{1,2}],_}|_]}} = (catch dets:insert(T, {1,2})), - ?line {'EXIT', {badarg, [{dets,insert,[T,[{1,2}]]}|_]}} = + ?line {'EXIT', {badarg, [{dets,insert,[T,[{1,2}]],_}|_]}} = (catch dets:insert(T, [{1,2}])), - ?line {'EXIT', {badarg, [{dets,insert,[T,[{1,2,3}|3]]}|_]}} = + ?line {'EXIT', {badarg, [{dets,insert,[T,[{1,2,3}|3]],_}|_]}} = (catch dets:insert(T, [{1,2,3} | 3])), %% lookup{_keys} - ?line {'EXIT', {badarg, [{dets,lookup_keys,[badarg,[]]}|_]}} = + ?line {'EXIT', {badarg, [{dets,lookup_keys,[badarg,[]],_}|_]}} = (catch dets:lookup_keys(T, [])), - ?line {'EXIT', {badarg, [{dets,lookup,[no_table,1]}|_]}} = + ?line {'EXIT', {badarg, [{dets,lookup,[no_table,1],_}|_]}} = (catch dets:lookup(no_table, 1)), - ?line {'EXIT', {badarg, [{dets,lookup_keys,[T,[1|2]]}|_]}} = + ?line {'EXIT', {badarg, [{dets,lookup_keys,[T,[1|2]],_}|_]}} = (catch dets:lookup_keys(T, [1 | 2])), %% member - ?line {'EXIT', {badarg, [{dets,member,[no_table,1]}|_]}} = + ?line {'EXIT', {badarg, [{dets,member,[no_table,1],_}|_]}} = (catch dets:member(no_table, 1)), %% sync - ?line {'EXIT', {badarg, [{dets,sync,[no_table]}|_]}} = + ?line {'EXIT', {badarg, [{dets,sync,[no_table],_}|_]}} = (catch dets:sync(no_table)), %% delete{_keys} - ?line {'EXIT', {badarg, [{dets,delete,[no_table,1]}|_]}} = + ?line {'EXIT', {badarg, [{dets,delete,[no_table,1],_}|_]}} = (catch dets:delete(no_table, 1)), %% delete_object - ?line {'EXIT', {badarg, [{dets,delete_object,[no_table,{1,2,3}]}|_]}} = + ?line {'EXIT', {badarg, [{dets,delete_object,[no_table,{1,2,3}],_}|_]}} = (catch dets:delete_object(no_table, {1,2,3})), - ?line {'EXIT', {badarg, [{dets,delete_object,[T,{1,2}]}|_]}} = + ?line {'EXIT', {badarg, [{dets,delete_object,[T,{1,2}],_}|_]}} = (catch dets:delete_object(T, {1,2})), - ?line {'EXIT', {badarg, [{dets,delete_object,[no_table,[{1,2,3}]]}|_]}} = + ?line {'EXIT', {badarg, [{dets,delete_object,[no_table,[{1,2,3}]],_}|_]}} = (catch dets:delete_object(no_table, [{1,2,3}])), - ?line {'EXIT', {badarg, [{dets,delete_object,[T,[{1,2}]]}|_]}} = + ?line {'EXIT', {badarg, [{dets,delete_object,[T,[{1,2}]],_}|_]}} = (catch dets:delete_object(T, [{1,2}])), - ?line {'EXIT', {badarg, [{dets,delete_object,[T,[{1,2,3}|3]]}|_]}} = + ?line {'EXIT', {badarg, [{dets,delete_object,[T,[{1,2,3}|3]],_}|_]}} = (catch dets:delete_object(T, [{1,2,3} | 3])), %% first,next,slot - ?line {'EXIT', {badarg, [{dets,first,[no_table]}|_]}} = + ?line {'EXIT', {badarg, [{dets,first,[no_table],_}|_]}} = (catch dets:first(no_table)), - ?line {'EXIT', {badarg, [{dets,next,[no_table,1]}|_]}} = + ?line {'EXIT', {badarg, [{dets,next,[no_table,1],_}|_]}} = (catch dets:next(no_table, 1)), - ?line {'EXIT', {badarg, [{dets,slot,[no_table,0]}|_]}} = + ?line {'EXIT', {badarg, [{dets,slot,[no_table,0],_}|_]}} = (catch dets:slot(no_table, 0)), %% info @@ -2321,26 +2322,26 @@ badarg(Config) when is_list(Config) -> ?line undefined = dets:info(T, foo), %% match_delete - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = + ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = (catch dets:match_delete(no_table, '_')), %% delete_all_objects - ?line {'EXIT', {badarg, [{dets,delete_all_objects,[no_table]}|_]}} = + ?line {'EXIT', {badarg, [{dets,delete_all_objects,[no_table],_}|_]}} = (catch dets:delete_all_objects(no_table)), %% select_delete MSpec = [{'_',[],['$_']}], - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = + ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = (catch dets:select_delete(no_table, MSpec)), - ?line {'EXIT', {badarg, [{dets,select_delete,[T, <<17>>]}|_]}} = + ?line {'EXIT', {badarg, [{dets,select_delete,[T, <<17>>],_}|_]}} = (catch dets:select_delete(T, <<17>>)), %% traverse, fold - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = + ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = (catch dets:traverse(no_table, fun(_) -> continue end)), - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = + ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = (catch dets:foldl(fun(_, A) -> A end, [], no_table)), - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = + ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true],_}|_]}} = (catch dets:foldr(fun(_, A) -> A end, [], no_table)), %% close @@ -2349,14 +2350,14 @@ badarg(Config) when is_list(Config) -> ?line {error, not_owner} = dets:close(T), %% init_table - ?line {'EXIT', {badarg,[{dets,init_table,[no_table,_,[]]}|_]}} = + ?line {'EXIT', {badarg,[{dets,init_table,[no_table,_,[]],_}|_]}} = (catch dets:init_table(no_table, fun(X) -> X end)), - ?line {'EXIT', {badarg,[{dets,init_table,[no_table,_,[]]}|_]}} = + ?line {'EXIT', {badarg,[{dets,init_table,[no_table,_,[]],_}|_]}} = (catch dets:init_table(no_table, fun(X) -> X end, [])), %% from_ets Ets = ets:new(ets,[]), - ?line {'EXIT', {badarg,[{dets,from_ets,[no_table,_]}|_]}} = + ?line {'EXIT', {badarg,[{dets,from_ets,[no_table,_],_}|_]}} = (catch dets:from_ets(no_table, Ets)), ets:delete(Ets), diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 57df963ae2..e048764a55 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -795,16 +795,16 @@ t_ets_dets(Config, Opts) -> ?line true = ets:from_dets(ETab,DTab), ?line 3000 = ets:info(ETab,size), ?line ets:delete(ETab), - ?line {'EXIT',{badarg,[{ets,to_dets,[ETab,DTab]}|_]}} = + ?line {'EXIT',{badarg,[{ets,to_dets,[ETab,DTab],_}|_]}} = (catch ets:to_dets(ETab,DTab)), - ?line {'EXIT',{badarg,[{ets,from_dets,[ETab,DTab]}|_]}} = + ?line {'EXIT',{badarg,[{ets,from_dets,[ETab,DTab],_}|_]}} = (catch ets:from_dets(ETab,DTab)), ?line ETab2 = ets_new(x,Opts), ?line filltabint(ETab2,3000), ?line dets:close(DTab), - ?line {'EXIT',{badarg,[{ets,to_dets,[ETab2,DTab]}|_]}} = + ?line {'EXIT',{badarg,[{ets,to_dets,[ETab2,DTab],_}|_]}} = (catch ets:to_dets(ETab2,DTab)), - ?line {'EXIT',{badarg,[{ets,from_dets,[ETab2,DTab]}|_]}} = + ?line {'EXIT',{badarg,[{ets,from_dets,[ETab2,DTab],_}|_]}} = (catch ets:from_dets(ETab2,DTab)), ?line ets:delete(ETab2), ?line (catch file:delete(Fname)), @@ -2652,7 +2652,7 @@ maybe_sort(L) when is_list(L) -> %maybe_sort({'EXIT',{Reason, [{Module, Function, _}|_]}}) -> % {'EXIT',{Reason, [{Module, Function, '_'}]}}; maybe_sort({'EXIT',{Reason, List}}) when is_list(List) -> - {'EXIT',{Reason, lists:map(fun({Module, Function, _}) -> + {'EXIT',{Reason, lists:map(fun({Module, Function, _, _}) -> {Module, Function, '_'} end, List)}}; diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 3010f5e760..1de639a166 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -97,11 +97,12 @@ wildcard_errors(Config) when is_list(Config) -> wcc(Wc, Error) -> {'EXIT',{{badpattern,Error}, - [{filelib,compile_wildcard,1}|_]}} = (catch filelib:compile_wildcard(Wc)), + [{filelib,compile_wildcard,1,_}|_]}} = + (catch filelib:compile_wildcard(Wc)), {'EXIT',{{badpattern,Error}, - [{filelib,wildcard,1}|_]}} = (catch filelib:wildcard(Wc)), + [{filelib,wildcard,1,_}|_]}} = (catch filelib:wildcard(Wc)), {'EXIT',{{badpattern,Error}, - [{filelib,wildcard,2}|_]}} = (catch filelib:wildcard(Wc, ".")). + [{filelib,wildcard,2,_}|_]}} = (catch filelib:wildcard(Wc, ".")). do_wildcard_1(Dir, Wcf0) -> do_wildcard_2(Dir, Wcf0), diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl index 1565aa9bba..c95089117c 100644 --- a/lib/stdlib/test/proc_lib_SUITE.erl +++ b/lib/stdlib/test/proc_lib_SUITE.erl @@ -328,7 +328,7 @@ otp_6345(doc) -> ["'monitor' spawn_opt option"]; otp_6345(Config) when is_list(Config) -> Opts = [link,monitor], - {'EXIT', {badarg,[{proc_lib,check_for_monitor,_}|_Stack]}} = + {'EXIT', {badarg,[{proc_lib,check_for_monitor,_,_}|_Stack]}} = (catch proc_lib:start(?MODULE, otp_6345_init, [self()], 1000, Opts)), ok. diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl index c4817c0d38..3b2e637c84 100644 --- a/lib/stdlib/test/re_SUITE.erl +++ b/lib/stdlib/test/re_SUITE.erl @@ -454,115 +454,115 @@ error_handling(Config) when is_list(Config) -> % The malformed precomiled RE is detected after % the trap to re:grun from grun, in the grun function clause % that handles precompiled expressions - ?line {'EXIT',{badarg,[{re,run,["apa",{1,2,3,4},[global]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,run,["apa",{1,2,3,4},[global]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:run("apa",{1,2,3,4},[global])), % An invalid capture list will also cause a badarg late, % but with a non pre compiled RE, the exception should be thrown by the % grun function clause that handles RE's compiled implicitly by % the run/3 BIF before trapping. - ?line {'EXIT',{badarg,[{re,run,["apa","p",[{capture,[1,{a}]},global]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,run,["apa","p",[{capture,[1,{a}]},global]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:run("apa","p",[{capture,[1,{a}]},global])), % And so the case of a precompiled expression together with % a compile-option (binary and list subject): ?line {ok,RE} = re:compile("(p)"), ?line {match,[[{1,1},{1,1}]]} = re:run(<<"apa">>,RE,[global]), ?line {match,[[{1,1},{1,1}]]} = re:run("apa",RE,[global]), - {'EXIT',{badarg,[{re,run, - [<<"apa">>, - {re_pattern,1,0,_}, - [global,unicode]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,run, + [<<"apa">>, + {re_pattern,1,0,_}, + [global,unicode]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:run(<<"apa">>,RE,[global,unicode])), - {'EXIT',{badarg,[{re,run, - ["apa", - {re_pattern,1,0,_}, - [global,unicode]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,run, + ["apa", + {re_pattern,1,0,_}, + [global,unicode]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:run("apa",RE,[global,unicode])), ?line {'EXIT',{badarg,_}} = (catch re:run("apa","(p",[])), ?line {'EXIT',{badarg,_}} = (catch re:run("apa","(p",[global])), % The replace errors: - ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:replace("apa",{1,2,3,4},"X",[])), - ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[global]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[global]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:replace("apa",{1,2,3,4},"X",[global])), ?line {'EXIT',{badarg,[{re,replace, ["apa", {re_pattern,1,0,_}, "X", - [unicode]]}, - {?MODULE, error_handling,1} | _]}} = + [unicode]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:replace("apa",RE,"X",[unicode])), ?line <<"aXa">> = iolist_to_binary(re:replace("apa","p","X",[])), ?line {'EXIT',{badarg,[{re,replace, - ["apa","p","X",[{capture,all,binary}]]}, - {?MODULE, error_handling,1} | _]}} = + ["apa","p","X",[{capture,all,binary}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch iolist_to_binary(re:replace("apa","p","X", [{capture,all,binary}]))), ?line {'EXIT',{badarg,[{re,replace, - ["apa","p","X",[{capture,all}]]}, - {?MODULE, error_handling,1} | _]}} = + ["apa","p","X",[{capture,all}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch iolist_to_binary(re:replace("apa","p","X", [{capture,all}]))), ?line {'EXIT',{badarg,[{re,replace, - ["apa","p","X",[{return,banana}]]}, - {?MODULE, error_handling,1} | _]}} = + ["apa","p","X",[{return,banana}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch iolist_to_binary(re:replace("apa","p","X", [{return,banana}]))), ?line {'EXIT',{badarg,_}} = (catch re:replace("apa","(p","X",[])), % Badarg, not compile error. ?line {'EXIT',{badarg,[{re,replace, - ["apa","(p","X",[{return,banana}]]}, - {?MODULE, error_handling,1} | _]}} = + ["apa","(p","X",[{return,banana}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch iolist_to_binary(re:replace("apa","(p","X", [{return,banana}]))), % And the split errors: ?line [<<"a">>,<<"a">>] = (catch re:split("apa","p",[])), ?line [<<"a">>,<<"p">>,<<"a">>] = (catch re:split("apa",RE,[])), - ?line {'EXIT',{badarg,[{re,split,["apa","p",[global]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa","p",[global]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa","p",[global])), - ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all}]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa","p",[{capture,all}])), - ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all,binary}]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all,binary}]],_}, + {?MODULE, error_handling,1,_} | _]}} = (catch re:split("apa","p",[{capture,all,binary}])), - ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",{1,2,3,4})), - ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",{1,2,3,4},[])), ?line {'EXIT',{badarg,[{re,split, ["apa", RE, - [unicode]]}, - {?MODULE, error_handling,1} | _]}} = + [unicode]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",RE,[unicode])), ?line {'EXIT',{badarg,[{re,split, ["apa", RE, - [{return,banana}]]}, - {?MODULE, error_handling,1} | _]}} = + [{return,banana}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",RE,[{return,banana}])), ?line {'EXIT',{badarg,[{re,split, ["apa", RE, - [banana]]}, - {?MODULE, error_handling,1} | _]}} = + [banana]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",RE,[banana])), ?line {'EXIT',{badarg,_}} = (catch re:split("apa","(p")), %Exception on bad argument, not compilation error ?line {'EXIT',{badarg,[{re,split, ["apa", "(p", - [banana]]}, - {?MODULE, error_handling,1} | _]}} = + [banana]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa","(p",[banana])), ?t:timetrap_cancel(Dog), ok. diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 8273377ba1..b6019b86f0 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -2388,12 +2388,12 @@ otp_6554(Config) when is_list(Config) -> comm_err(<<"V = lists:seq(1, 20), case V of a -> ok end.">>), ?line "exception error: no function clause matching" = comm_err(<<"fun(P) when is_pid(P) -> true end(a).">>), - ?line "exception error: {function_clause,[{erl_eval,do_apply,[unproper|list]}"++_ = + ?line "exception error: {function_clause," = comm_err(<<"erlang:error(function_clause, [unproper | list]).">>), ?line "exception error: function_clause" = comm_err(<<"erlang:error(function_clause, 4).">>), %% Cheating: - ?line "exception error: no function clause matching erl_eval:do_apply(4)" = + ?line "exception error: no function clause matching erl_eval:do_apply(4)" ++ _ = comm_err(<<"erlang:error(function_clause, [4]).">>), ?line "exception error: no function clause matching" ++ _ = comm_err(<<"fun(a, b, c, d) -> foo end" @@ -2406,7 +2406,7 @@ otp_6554(Config) when is_list(Config) -> comm_err(<<"fun(P, q) when is_pid(P) -> true end(a, b).">>), ?line "exception error: no function clause matching lists:reverse(" ++ _ = comm_err(<<"F=fun() -> hello end, lists:reverse(F).">>), - ?line "exception error: no function clause matching lists:reverse(34)" = + ?line "exception error: no function clause matching lists:reverse(34) (lists.erl, line " ++ _ = comm_err(<<"lists:reverse(34).">>), ?line "exception error: no true branch found when evaluating an if expression" = comm_err(<<"if length([a,b]) > 17 -> a end.">>), diff --git a/lib/stdlib/test/sofs_SUITE.erl b/lib/stdlib/test/sofs_SUITE.erl index d6f88a655e..73b282149a 100644 --- a/lib/stdlib/test/sofs_SUITE.erl +++ b/lib/stdlib/test/sofs_SUITE.erl @@ -1879,11 +1879,11 @@ digraph(Conf) when is_list(Conf) -> ?line {'EXIT', {badarg, _}} = (catch family_to_digraph(set([a]))), - ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_]}|_]}} = + ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_],_}|_]}} = (catch family_to_digraph(set([a]), [foo])), - ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_]}|_]}} = + ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_],_}|_]}} = (catch family_to_digraph(F, [foo])), - ?line {'EXIT', {cyclic, [{sofs,family_to_digraph,[_,_]}|_]}} = + ?line {'EXIT', {cyclic, [{sofs,family_to_digraph,[_,_],_}|_]}} = (catch family_to_digraph(family([{a,[a]}]),[acyclic])), ?line G1 = family_to_digraph(E), diff --git a/lib/stdlib/test/supervisor_1.erl b/lib/stdlib/test/supervisor_1.erl index 3198be0fed..f819594c46 100644 --- a/lib/stdlib/test/supervisor_1.erl +++ b/lib/stdlib/test/supervisor_1.erl @@ -62,6 +62,12 @@ handle_info(die, State) -> handle_info(stop, State) -> {stop, normal, State}; +handle_info({'EXIT',_,shutdown}, State) -> + {stop, shutdown, State}; + +handle_info({'EXIT',_,{shutdown,Term}}, State) -> + {stop, {shutdown,Term}, State}; + handle_info({sleep, Time}, State) -> io:format("FOO: ~p~n", [Time]), timer:sleep(Time), diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index b48450c151..2aa3131aeb 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -41,6 +41,8 @@ %% Tests concept permanent, transient and temporary -export([ permanent_normal/1, transient_normal/1, temporary_normal/1, + permanent_shutdown/1, transient_shutdown/1, + temporary_shutdown/1, permanent_abnormal/1, transient_abnormal/1, temporary_abnormal/1, temporary_bystander/1]). @@ -71,6 +73,7 @@ all() -> {group, restart_simple_one_for_one}, {group, restart_rest_for_one}, {group, normal_termination}, + {group, shutdown_termination}, {group, abnormal_termination}, child_unlink, tree, count_children_memory, do_not_save_start_parameters_for_temporary_children, do_not_save_child_specs_for_temporary_children, @@ -86,6 +89,8 @@ groups() -> sup_stop_brutal_kill]}, {normal_termination, [], [permanent_normal, transient_normal, temporary_normal]}, + {shutdown_termination, [], + [permanent_shutdown, transient_shutdown, temporary_shutdown]}, {abnormal_termination, [], [permanent_abnormal, transient_abnormal, temporary_abnormal]}, @@ -549,6 +554,87 @@ temporary_normal(Config) when is_list(Config) -> [0,0,0,0] = get_child_counts(sup_test). %%------------------------------------------------------------------------- +permanent_shutdown(doc) -> + ["A permanent child should always be restarted"]; +permanent_shutdown(suite) -> []; +permanent_shutdown(Config) when is_list(Config) -> + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), + Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, + worker, []}, + + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + + terminate(SupPid, CPid1, child1, shutdown), + + [{child1, CPid2 ,worker,[]}] = supervisor:which_children(sup_test), + case is_pid(CPid2) of + true -> + ok; + false -> + test_server:fail({permanent_child_not_restarted, Child1}) + end, + [1,1,0,1] = get_child_counts(sup_test), + + terminate(SupPid, CPid2, child1, {shutdown, some_info}), + + [{child1, CPid3 ,worker,[]}] = supervisor:which_children(sup_test), + case is_pid(CPid3) of + true -> + ok; + false -> + test_server:fail({permanent_child_not_restarted, Child1}) + end, + + [1,1,0,1] = get_child_counts(sup_test). + +%%------------------------------------------------------------------------- +transient_shutdown(doc) -> + ["A transient child should not be restarted if it exits with " + "reason shutdown or {shutdown,Term}"]; +transient_shutdown(suite) -> []; +transient_shutdown(Config) when is_list(Config) -> + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), + Child1 = {child1, {supervisor_1, start_child, []}, transient, 1000, + worker, []}, + + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + + terminate(SupPid, CPid1, child1, shutdown), + + [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test), + [1,0,0,1] = get_child_counts(sup_test), + + {ok, CPid2} = supervisor:restart_child(sup_test, child1), + + terminate(SupPid, CPid2, child1, {shutdown, some_info}), + + [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test), + [1,0,0,1] = get_child_counts(sup_test). + +%%------------------------------------------------------------------------- +temporary_shutdown(doc) -> + ["A temporary process should never be restarted"]; +temporary_shutdown(suite) -> []; +temporary_shutdown(Config) when is_list(Config) -> + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), + Child1 = {child1, {supervisor_1, start_child, []}, temporary, 1000, + worker, []}, + + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + + terminate(SupPid, CPid1, child1, shutdown), + + [] = supervisor:which_children(sup_test), + [0,0,0,0] = get_child_counts(sup_test), + + {ok, CPid2} = supervisor:start_child(sup_test, Child1), + + terminate(SupPid, CPid2, child1, {shutdown, some_info}), + + [] = supervisor:which_children(sup_test), + [0,0,0,0] = get_child_counts(sup_test). + +%%------------------------------------------------------------------------- permanent_abnormal(doc) -> ["A permanent child should always be restarted"]; permanent_abnormal(suite) -> []; @@ -1282,6 +1368,13 @@ terminate(_, ChildPid, _, shutdown) -> {'DOWN', Ref, process, ChildPid, shutdown} -> ok end; +terminate(_, ChildPid, _, {shutdown, Term}) -> + Ref = erlang:monitor(process, ChildPid), + exit(ChildPid, {shutdown, Term}), + receive + {'DOWN', Ref, process, ChildPid, {shutdown, Term}} -> + ok + end; terminate(_, ChildPid, _, normal) -> Ref = erlang:monitor(process, ChildPid), ChildPid ! stop, diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk index 9d4ed17774..2f0ecd3863 100644 --- a/lib/stdlib/vsn.mk +++ b/lib/stdlib/vsn.mk @@ -1 +1 @@ -STDLIB_VSN = 1.17.5 +STDLIB_VSN = 1.18 diff --git a/lib/test_server/include/test_server.hrl b/lib/test_server/include/test_server.hrl index 4b96d84ace..36e7e1f83d 100644 --- a/lib/test_server/include/test_server.hrl +++ b/lib/test_server/include/test_server.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -20,11 +20,10 @@ -ifdef(line_trace). -line_trace(true). -define(line, - put(test_server_loc,{?MODULE,?LINE}), io:format(lists:concat([?MODULE,",",integer_to_list(?LINE),": ~p"]), [erlang:now()]),). -else. --define(line,put(test_server_loc,{?MODULE,?LINE}),). +-define(line,). -endif. -define(t,test_server). -define(config,test_server:lookup_config). diff --git a/lib/test_server/include/test_server_line.hrl b/lib/test_server/include/test_server_line.hrl index 60ef860883..3c309d3ee5 100644 --- a/lib/test_server/include/test_server_line.hrl +++ b/lib/test_server/include/test_server_line.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -16,5 +16,4 @@ %% %% %CopyrightEnd% %% --compile({parse_transform,test_server_line}). diff --git a/lib/test_server/src/Makefile b/lib/test_server/src/Makefile index 63a585d526..4bc51873c2 100644 --- a/lib/test_server/src/Makefile +++ b/lib/test_server/src/Makefile @@ -43,7 +43,6 @@ MODULES= test_server_ctrl \ test_server_node \ test_server \ test_server_sup \ - test_server_line \ test_server_h \ erl2html2 \ vxworks_client diff --git a/lib/test_server/src/test_server.app.src b/lib/test_server/src/test_server.app.src index af2d4dc2cb..7e87583a7b 100644 --- a/lib/test_server/src/test_server.app.src +++ b/lib/test_server/src/test_server.app.src @@ -24,7 +24,6 @@ test_server_ctrl, test_server, test_server_h, - test_server_line, test_server_node, test_server_sup ]}, diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 591329b361..04f92c5738 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -759,7 +759,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, Comment,undefined); Loc1 -> - {Mod,Func} = get_mf(Loc1), %% call end_per_testcase on a separate process, %% only so that the user has a chance to clean up %% after init_per_testcase, even after a timetrap timeout @@ -775,6 +774,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> TVal), {EndConfPid,{Mod,Func},Conf}; _ -> + {Mod,Func} = get_mf(Loc1), %% The framework functions mustn't execute on this %% group leader process or io will cause deadlock, %% so we spawn a dedicated process for the operation @@ -810,7 +810,6 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> run_test_case_msgloop(Ref,Pid,CaptureStdout,Terminate, Comment,undefined); Loc1 -> - {Mod,Func} = get_mf(Loc1), %% call end_per_testcase on a separate process, only so %% that the user has a chance to clean up after init_per_testcase, %% even after abortion @@ -828,6 +827,7 @@ run_test_case_msgloop(Ref, Pid, CaptureStdout, Terminate, Comment, CurrConf) -> TVal), {EndConfPid,{Mod,Func},Conf}; _ -> + {Mod,Func} = get_mf(Loc1), spawn_fw_call(Mod,Func,Pid,ErrorMsg, Loc1,self(),Comment), undefined @@ -1307,57 +1307,62 @@ init_per_testcase(Mod, Func, Args) -> false -> code:load_file(Mod); _ -> ok end, - %% init_per_testcase defined, returns new configuration - case erlang:function_exported(Mod,init_per_testcase,2) of + case erlang:function_exported(Mod, init_per_testcase, 2) of true -> - case catch my_apply(Mod, init_per_testcase, [Func|Args]) of - {'$test_server_ok',{Skip,Reason}} when Skip==skip; - Skip==skipped -> - {skip,Reason}; - {'$test_server_ok',Res={skip_and_save,_,_}} -> - Res; - {'$test_server_ok',NewConf} when is_list(NewConf) -> - case lists:filter(fun(T) when is_tuple(T) -> false; - (_) -> true end, NewConf) of - [] -> - {ok,NewConf}; - Bad -> - group_leader() ! {printout,12, - "ERROR! init_per_testcase has returned " - "bad elements in Config: ~p\n",[Bad]}, - {skip,{failed,{Mod,init_per_testcase,bad_return}}} - end; - {'$test_server_ok',Res={fail,_Reason}} -> - Res; - {'$test_server_ok',_Other} -> - group_leader() ! {printout,12, - "ERROR! init_per_testcase did not return " - "a Config list.\n",[]}, - {skip,{failed,{Mod,init_per_testcase,bad_return}}}; - {'EXIT',Reason} -> - Line = get_loc(), - FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), - group_leader() ! {printout,12, - "ERROR! init_per_testcase crashed!\n" - "\tLocation: ~s\n\tReason: ~p\n", - [FormattedLoc,Reason]}, - {skip,{failed,{Mod,init_per_testcase,Reason}}}; - Other -> - Line = get_loc(), - FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), - group_leader() ! {printout,12, - "ERROR! init_per_testcase thrown!\n" - "\tLocation: ~s\n\tReason: ~p\n", - [FormattedLoc, Other]}, - {skip,{failed,{Mod,init_per_testcase,Other}}} - end; + do_init_per_testcase(Mod, [Func|Args]); false -> -%% Optional init_per_testcase not defined -%% keep quiet. + %% Optional init_per_testcase is not defined -- keep quiet. [Config] = Args, {ok, Config} end. +do_init_per_testcase(Mod, Args) -> + try apply(Mod, init_per_testcase, Args) of + {Skip,Reason} when Skip =:= skip; Skip =:= skipped -> + {skip,Reason}; + {skip_and_save,_,_}=Res -> + Res; + NewConf when is_list(NewConf) -> + case lists:filter(fun(T) when is_tuple(T) -> false; + (_) -> true end, NewConf) of + [] -> + {ok,NewConf}; + Bad -> + group_leader() ! {printout,12, + "ERROR! init_per_testcase has returned " + "bad elements in Config: ~p\n",[Bad]}, + {skip,{failed,{Mod,init_per_testcase,bad_return}}} + end; + {fail,_Reason}=Res -> + Res; + _Other -> + group_leader() ! {printout,12, + "ERROR! init_per_testcase did not return " + "a Config list.\n",[]}, + {skip,{failed,{Mod,init_per_testcase,bad_return}}} + catch + throw:Other -> + set_loc(erlang:get_stacktrace()), + Line = get_loc(), + FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), + group_leader() ! {printout,12, + "ERROR! init_per_testcase thrown!\n" + "\tLocation: ~s\n\tReason: ~p\n", + [FormattedLoc, Other]}, + {skip,{failed,{Mod,init_per_testcase,Other}}}; + _:Reason0 -> + Stk = erlang:get_stacktrace(), + Reason = {Reason0,Stk}, + set_loc(Stk), + Line = get_loc(), + FormattedLoc = test_server_sup:format_loc(mod_loc(Line)), + group_leader() ! {printout,12, + "ERROR! init_per_testcase crashed!\n" + "\tLocation: ~s\n\tReason: ~p\n", + [FormattedLoc,Reason]}, + {skip,{failed,{Mod,init_per_testcase,Reason}}} + end. + end_per_testcase(Mod, Func, Conf) -> case erlang:function_exported(Mod,end_per_testcase,2) of true -> @@ -1375,57 +1380,79 @@ end_per_testcase(Mod, Func, Conf) -> do_end_per_testcase(Mod,EndFunc,Func,Conf) -> put(test_server_init_or_end_conf,{EndFunc,Func}), put(test_server_loc, {Mod,{EndFunc,Func}}), - case catch my_apply(Mod, EndFunc, [Func,Conf]) of - {'$test_server_ok',SaveCfg={save_config,_}} -> + try Mod:EndFunc(Func, Conf) of + {save_config,_}=SaveCfg -> SaveCfg; - {'$test_server_ok',{fail,_}=Fail} -> + {fail,_}=Fail -> Fail; - {'$test_server_ok',_} -> - ok; - {'EXIT',Reason} = Why -> + _ -> + ok + catch + throw:Other -> + set_loc(erlang:get_stacktrace()), comment(io_lib:format("<font color=\"red\">" - "WARNING: ~w crashed!" + "WARNING: ~w thrown!" "</font>\n",[EndFunc])), group_leader() ! {printout,12, - "WARNING: ~w crashed!\n" + "WARNING: ~w thrown!\n" "Reason: ~p\n" "Line: ~s\n", - [EndFunc, Reason, + [EndFunc, Other, test_server_sup:format_loc( mod_loc(get_loc()))]}, - {failed,{Mod,end_per_testcase,Why}}; - Other -> + {failed,{Mod,end_per_testcase,Other}}; + Class:Reason -> + Stk = erlang:get_stacktrace(), + set_loc(Stk), + Why = case Class of + exit -> {'EXIT',Reason}; + error -> {'EXIT',{Reason,Stk}} + end, comment(io_lib:format("<font color=\"red\">" - "WARNING: ~w thrown!" + "WARNING: ~w crashed!" "</font>\n",[EndFunc])), group_leader() ! {printout,12, - "WARNING: ~w thrown!\n" + "WARNING: ~w crashed!\n" "Reason: ~p\n" "Line: ~s\n", - [EndFunc, Other, + [EndFunc, Reason, test_server_sup:format_loc( mod_loc(get_loc()))]}, - {failed,{Mod,end_per_testcase,Other}} + {failed,{Mod,end_per_testcase,Why}} end. get_loc() -> - case catch test_server_line:get_lines() of - [] -> - get(test_server_loc); - {'EXIT',_} -> - get(test_server_loc); - Loc -> - Loc - end. + get(test_server_loc). get_loc(Pid) -> - {dictionary,Dict} = process_info(Pid, dictionary), - lists:foreach(fun({Key,Val}) -> put(Key,Val) end,Dict), + [{current_stacktrace,Stk0},{dictionary,Dict}] = + process_info(Pid, [current_stacktrace,dictionary]), + lists:foreach(fun({Key,Val}) -> put(Key, Val) end, Dict), + Stk = [rewrite_loc_item(Loc) || Loc <- Stk0], + put(test_server_loc, Stk), get_loc(). -get_mf([{M,F,_}|_]) -> {M,F}; -get_mf([{M,F}|_]) -> {M,F}; -get_mf(_) -> {undefined,undefined}. +%% find the latest known Suite:Testcase +get_mf(MFs) -> + get_mf(MFs, {undefined,undefined}). + +get_mf([MF|MFs], Found) when is_tuple(MF) -> + ModFunc = {Mod,_} = case MF of + {M,F,_} -> {M,F}; + MF -> MF + end, + case is_suite(Mod) of + true -> ModFunc; + false -> get_mf(MFs, ModFunc) + end; +get_mf(_, Found) -> + Found. + +is_suite(Mod) -> + case lists:reverse(atom_to_list(Mod)) of + "ETIUS" ++ _ -> true; + _ -> false + end. mod_loc(Loc) -> %% handle diff line num versions @@ -1498,16 +1525,22 @@ lookup_config(Key,Config) -> %% timer:tc/3 ts_tc(M, F, A) -> Before = erlang:now(), - Val = (catch my_apply(M, F, A)), + Result = try + apply(M, F, A) + catch + Type:Reason -> + Stk = erlang:get_stacktrace(), + set_loc(Stk), + case Type of + throw -> + {failed,{thrown,Reason}}; + error -> + {'EXIT',{Reason,Stk}}; + exit -> + {'EXIT',Reason} + end + end, After = erlang:now(), - Result = case Val of - {'$test_server_ok', R} -> - R; % test case ok - {'EXIT',_Reason} = R -> - R; % test case crashed - Other -> - {failed, {thrown,Other}} % test case was thrown - end, Elapsed = (element(1,After)*1000000000000 +element(2,After)*1000000+element(3,After)) - @@ -1515,8 +1548,12 @@ ts_tc(M, F, A) -> +element(2,Before)*1000000+element(3,Before)), {Elapsed, Result}. -my_apply(M, F, A) -> - {'$test_server_ok',apply(M, F, A)}. +set_loc(Stk) -> + Loc = [rewrite_loc_item(I) || {_,_,_,_}=I <- Stk], + put(test_server_loc, Loc). + +rewrite_loc_item({M,F,_,Loc}) -> + {M,F,proplists:get_value(line, Loc, 0)}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/test_server/src/test_server_line.erl b/lib/test_server/src/test_server_line.erl deleted file mode 100644 index 848a9c23dd..0000000000 --- a/lib/test_server/src/test_server_line.erl +++ /dev/null @@ -1,387 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2010. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% --module(test_server_line). - -%% User interface --export([get_lines/0]). --export([clear/0]). - -%% Parse transform functions --export([parse_transform/2]). --export(['$test_server_line'/3]). --export(['$test_server_lineQ'/3]). --export([trace_line/3]). - --define(TEST_SERVER_LINE_SIZE, 10). -%-define(STORAGE_FUNCTION, '$test_server_line'). --define(STORAGE_FUNCTION, '$test_server_lineQ'). - --include("test_server.hrl"). - --record(vars, {module, % atom() Module name - function, % atom() Function name - arity, % int() Function arity - lines, % [int()] seen lines - is_guard=false, % boolean() - no_lines=[], % [{atom(),integer()}] - % Functions to exclude - line_trace=false - }). - - - - -%% Process dictionary littering variant -%% - -'$test_server_line'(Mod, Func, Line) -> - {Prev,Next} = - case get('$test_server_line') of - I when is_integer(I) -> - if 1 =< I, I < ?TEST_SERVER_LINE_SIZE -> {I,I+1}; - true -> {?TEST_SERVER_LINE_SIZE,1} - end; - _ -> {?TEST_SERVER_LINE_SIZE,1} - end, - PrevTag = {'$test_server_line',Prev}, - case get(PrevTag) of - {Mod,Func,_} -> put(PrevTag, {Mod,Func,Line}); - _ -> - put({'$test_server_line',Next}, {Mod,Func,Line}), - put('$test_server_line', Next) - end, ok. - -test_server_line_get() -> - case get('$test_server_line') of - I when is_integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE -> - test_server_line_get_1(?TEST_SERVER_LINE_SIZE, I, []); - _ -> [] - end. - -test_server_line_get_1(0, _I, R) -> - R; -test_server_line_get_1(Cnt, I, R) -> - J = if I < ?TEST_SERVER_LINE_SIZE -> I+1; - true -> 1 end, - case get({'$test_server_line',J}) of - undefined -> - %% Less than ?TEST_SERVER_LINE_SIZE number of lines stored - %% Start from line 1 and stop at actutual number of lines - case get({'$test_server_line',1}) of - undefined -> R; % no lines at all stored - E -> test_server_line_get_1(I-1,1,[E|R]) - end; - E -> - test_server_line_get_1(Cnt-1, J, [E|R]) - end. - -test_server_line_clear() -> - Is = lists:seq(1,?TEST_SERVER_LINE_SIZE), - lists:foreach(fun (I) -> erase({'$test_server_line',I}) end, Is), - erase('$test_server_line'), - ok. - - -%% Queue variant, uses just one process dictionary entry -%% - -'$test_server_lineQ'(Mod, Func, Line) -> - case get('$test_server_lineQ') of - {I,Q} when is_integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE -> - case queue:head(Q) of - {Mod,Func,_} -> - %% Replace queue head - put('$test_server_lineQ', - {I,queue:cons({Mod,Func,Line}, queue:tail(Q))}); - _ when I < ?TEST_SERVER_LINE_SIZE -> - put('$test_server_lineQ', - {I+1,queue:cons({Mod,Func,Line}, Q)}); - _ -> - %% Waste last in queue - put('$test_server_lineQ', - {I,queue:cons({Mod,Func,Line}, queue:lait(Q))}) - end; - _ -> - Q = queue:new(), - put('$test_server_lineQ', {1,queue:cons({Mod,Func,Line}, Q)}) - end, ok. - -%test_server_lineQ_get() -> -% case get('$test_server_lineQ') of -% {I,Q} when integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE -> -% queue:to_list(Q); -% _ -> [] -% end. - -test_server_lineQ_clear() -> - erase('$test_server_lineQ'), - ok. - - -%% Get line - check if queue or dictionary is used, then get the lines -%% - -get_lines() -> - case get('$test_server_lineQ') of - {I,Q} when is_integer(I), 1 =< I, I =< ?TEST_SERVER_LINE_SIZE -> - queue:to_list(Q); - _ -> - test_server_line_get() - end. - -%% Clear all dictionary entries -%% -clear() -> - test_server_line_clear(), - test_server_lineQ_clear(). - - -trace_line(Mod,Func,Line) -> - io:format(lists:concat([Mod,":",Func,",",integer_to_list(Line),": ~p"]), - [erlang:now()]). - - -%%%================================================================= -%%%========= **** PARSE TRANSFORM **** ======================== -%%%================================================================= -parse_transform(Forms, _Options) -> - transform(Forms, _Options). - -%% forms(Fs) -> lists:map(fun (F) -> form(F) end, Fs). - -transform(Forms, _Options)-> - Vars0 = #vars{}, - {ok, MungedForms, _Vars} = transform(Forms, [], Vars0), - MungedForms. - - -transform([Form|Forms], MungedForms, Vars) -> - case munge(Form, Vars) of - ignore -> - transform(Forms, MungedForms, Vars); - {MungedForm, Vars2} -> - transform(Forms, [MungedForm|MungedForms], Vars2) - end; -transform([], MungedForms, Vars) -> - {ok, lists:reverse(MungedForms), Vars}. - -%% This code traverses the abstract code, stored as the abstract_code -%% chunk in the BEAM file, as described in absform(3) for Erlang/OTP R8B -%% (Vsn=abstract_v2). -%% The abstract format after preprocessing differs slightly from the abstract -%% format given eg using epp:parse_form, this has been noted in comments. -munge(Form={attribute,_,module,Module}, Vars) -> - Vars2 = Vars#vars{module=Module}, - {Form, Vars2}; - -munge(Form={attribute,_,no_lines,Funcs}, Vars) -> - Vars2 = Vars#vars{no_lines=Funcs}, - {Form, Vars2}; - -munge(Form={attribute,_,line_trace,_}, Vars) -> - Vars2 = Vars#vars{line_trace=true}, - {Form, Vars2}; - -munge({function,0,module_info,_Arity,_Clauses}, _Vars) -> - ignore; % module_info will be added again when the forms are recompiled -munge(Form = {function,Line,Function,Arity,Clauses}, Vars) -> - case lists:member({Function,Arity},Vars#vars.no_lines) of - true -> - %% Line numbers in this function shall not be stored - {Form,Vars}; - false -> - Vars2 = Vars#vars{function=Function, - arity=Arity, - lines=[]}, - {MungedClauses, Vars3} = munge_clauses(Clauses, Vars2, []), - {{function,Line,Function,Arity,MungedClauses}, Vars3} - end; -munge(Form, Vars) -> % attributes - {Form, Vars}. - -munge_clauses([{clause,Line,Pattern,Guards,Body}|Clauses], Vars, MClauses) -> - {MungedGuards, _Vars} = munge_exprs(Guards, Vars#vars{is_guard=true},[]), - {MungedBody, Vars2} = munge_body(Body, Vars, []), - munge_clauses(Clauses, Vars2, - [{clause,Line,Pattern,MungedGuards,MungedBody}| - MClauses]); -munge_clauses([], Vars, MungedClauses) -> - {lists:reverse(MungedClauses), Vars}. - -munge_body([Expr|Body], Vars, MungedBody) -> - %% Here is the place to add a call to storage function! - Line = element(2, Expr), - Lines = Vars#vars.lines, - case lists:member(Line,Lines) of - true -> % already a bump at this line! - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_body(Body, Vars2, [MungedExpr|MungedBody]); - false -> - Bump = {call, 0, {remote,0, - {atom,0,?MODULE}, - {atom,0,?STORAGE_FUNCTION}}, - [{atom,0,Vars#vars.module}, - {atom, 0, Vars#vars.function}, - {integer, 0, Line}]}, - Lines2 = [Line|Lines], - - {MungedExpr, Vars2} = munge_expr(Expr, Vars#vars{lines=Lines2}), - MungedBody2 = - if Vars#vars.line_trace -> - LineTrace = {call, 0, {remote,0, - {atom,0,?MODULE}, - {atom,0,trace_line}}, - [{atom,0,Vars#vars.module}, - {atom, 0, Vars#vars.function}, - {integer, 0, Line}]}, - [MungedExpr,LineTrace,Bump|MungedBody]; - true -> - [MungedExpr,Bump|MungedBody] - end, - munge_body(Body, Vars2, MungedBody2) - end; -munge_body([], Vars, MungedBody) -> - {lists:reverse(MungedBody), Vars}. - -munge_expr({match,Line,ExprL,ExprR}, Vars) -> - {MungedExprL, Vars2} = munge_expr(ExprL, Vars), - {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), - {{match,Line,MungedExprL,MungedExprR}, Vars3}; -munge_expr({tuple,Line,Exprs}, Vars) -> - {MungedExprs, Vars2} = munge_exprs(Exprs, Vars, []), - {{tuple,Line,MungedExprs}, Vars2}; -munge_expr({record,Line,Expr,Exprs}, Vars) -> - %% Only for Vsn=raw_abstract_v1 - {MungedExprName, Vars2} = munge_expr(Expr, Vars), - {MungedExprFields, Vars3} = munge_exprs(Exprs, Vars2, []), - {{record,Line,MungedExprName,MungedExprFields}, Vars3}; -munge_expr({record_field,Line,ExprL,ExprR}, Vars) -> - %% Only for Vsn=raw_abstract_v1 - {MungedExprL, Vars2} = munge_expr(ExprL, Vars), - {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), - {{record_field,Line,MungedExprL,MungedExprR}, Vars3}; -munge_expr({cons,Line,ExprH,ExprT}, Vars) -> - {MungedExprH, Vars2} = munge_expr(ExprH, Vars), - {MungedExprT, Vars3} = munge_expr(ExprT, Vars2), - {{cons,Line,MungedExprH,MungedExprT}, Vars3}; -munge_expr({op,Line,Op,ExprL,ExprR}, Vars) -> - {MungedExprL, Vars2} = munge_expr(ExprL, Vars), - {MungedExprR, Vars3} = munge_expr(ExprR, Vars2), - {{op,Line,Op,MungedExprL,MungedExprR}, Vars3}; -munge_expr({op,Line,Op,Expr}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {{op,Line,Op,MungedExpr}, Vars2}; -munge_expr({'catch',Line,Expr}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {{'catch',Line,MungedExpr}, Vars2}; -munge_expr({call,Line1,{remote,Line2,ExprM,ExprF},Exprs}, - Vars) when Vars#vars.is_guard==false-> - {MungedExprM, Vars2} = munge_expr(ExprM, Vars), - {MungedExprF, Vars3} = munge_expr(ExprF, Vars2), - {MungedExprs, Vars4} = munge_exprs(Exprs, Vars3, []), - {{call,Line1,{remote,Line2,MungedExprM,MungedExprF},MungedExprs}, Vars4}; -munge_expr({call,Line1,{remote,_Line2,_ExprM,ExprF},Exprs}, - Vars) when Vars#vars.is_guard==true -> - %% Difference in abstract format after preprocessing: BIF calls in guards - %% are translated to {remote,...} (which is not allowed as source form) - %% NOT NECESSARY FOR Vsn=raw_abstract_v1 - munge_expr({call,Line1,ExprF,Exprs}, Vars); -munge_expr({call,Line,Expr,Exprs}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {MungedExprs, Vars3} = munge_exprs(Exprs, Vars2, []), - {{call,Line,MungedExpr,MungedExprs}, Vars3}; -munge_expr({lc,Line,Expr,LC}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {MungedLC, Vars3} = munge_lc(LC, Vars2, []), - {{lc,Line,MungedExpr,MungedLC}, Vars3}; -munge_expr({block,Line,Body}, Vars) -> - {MungedBody, Vars2} = munge_body(Body, Vars, []), - {{block,Line,MungedBody}, Vars2}; -munge_expr({'if',Line,Clauses}, Vars) -> - {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), - {{'if',Line,MungedClauses}, Vars2}; -munge_expr({'case',Line,Expr,Clauses}, Vars) -> - {MungedExpr,Vars2} = munge_expr(Expr,Vars), - {MungedClauses,Vars3} = munge_clauses(Clauses, Vars2, []), - {{'case',Line,MungedExpr,MungedClauses}, Vars3}; -munge_expr({'receive',Line,Clauses}, Vars) -> - {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), - {{'receive',Line,MungedClauses}, Vars2}; -munge_expr({'receive',Line,Clauses,Expr,Body}, Vars) -> - {MungedClauses,Vars2} = munge_clauses(Clauses, Vars, []), - {MungedExpr, Vars3} = munge_expr(Expr, Vars2), - {MungedBody, Vars4} = munge_body(Body, Vars3, []), - {{'receive',Line,MungedClauses,MungedExpr,MungedBody}, Vars4}; -munge_expr({'try',Line,Exprs,Clauses,CatchClauses,After}, Vars) -> - {MungedExprs, Vars1} = munge_exprs(Exprs, Vars, []), - {MungedClauses, Vars2} = munge_clauses(Clauses, Vars1, []), - {MungedCatchClauses, Vars3} = munge_clauses(CatchClauses, Vars2, []), - {MungedAfter, Vars4} = munge_body(After, Vars3, []), - {{'try',Line,MungedExprs,MungedClauses,MungedCatchClauses,MungedAfter}, - Vars4}; -%% Difference in abstract format after preprocessing: Funs get an extra -%% element Extra. -%% NOT NECESSARY FOR Vsn=raw_abstract_v1 -munge_expr({'fun',Line,{function,Name,Arity},_Extra}, Vars) -> - {{'fun',Line,{function,Name,Arity}}, Vars}; -munge_expr({'fun',Line,{clauses,Clauses},_Extra}, Vars) -> - {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []), - {{'fun',Line,{clauses,MungedClauses}}, Vars2}; -munge_expr({'fun',Line,{clauses,Clauses}}, Vars) -> - %% Only for Vsn=raw_abstract_v1 - {MungedClauses,Vars2}=munge_clauses(Clauses, Vars, []), - {{'fun',Line,{clauses,MungedClauses}}, Vars2}; -munge_expr({bc,Line,Expr,LC}, Vars) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - {MungedLC, Vars3} = munge_lc(LC, Vars2, []), - {{bc,Line,MungedExpr,MungedLC}, Vars3}; -munge_expr(Form, Vars) -> % var|char|integer|float|string|atom|nil|bin|eof - {Form, Vars}. - -munge_exprs([Expr|Exprs], Vars, MungedExprs) when Vars#vars.is_guard==true, - is_list(Expr) -> - {MungedExpr, _Vars} = munge_exprs(Expr, Vars, []), - munge_exprs(Exprs, Vars, [MungedExpr|MungedExprs]); -munge_exprs([Expr|Exprs], Vars, MungedExprs) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_exprs(Exprs, Vars2, [MungedExpr|MungedExprs]); -munge_exprs([], Vars, MungedExprs) -> - {lists:reverse(MungedExprs), Vars}. - -munge_lc([{generate,Line,Pattern,Expr}|LC], Vars, MungedLC) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_lc(LC, Vars2, [{generate,Line,Pattern,MungedExpr}|MungedLC]); -munge_lc([{b_generate,Line,Pattern,Expr}|LC], Vars, MungedLC) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_lc(LC, Vars2, [{b_generate,Line,Pattern,MungedExpr}|MungedLC]); -munge_lc([Expr|LC], Vars, MungedLC) -> - {MungedExpr, Vars2} = munge_expr(Expr, Vars), - munge_lc(LC, Vars2, [MungedExpr|MungedLC]); -munge_lc([], Vars, MungedLC) -> - {lists:reverse(MungedLC), Vars}. - - - - - - - - - - diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 53dfb45e3a..ec9be52bd3 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -51,18 +51,19 @@ timetrap(Timeout0, Scale, Pid) -> Timeout = if not Scale -> Timeout0; true -> test_server:timetrap_scale_factor() * Timeout0 end, + TruncTO = trunc(Timeout), receive - after trunc(Timeout) -> - Line = test_server:get_loc(Pid), + after TruncTO -> + MFLs = test_server:get_loc(Pid), Mon = erlang:monitor(process, Pid), Trap = case get(test_server_init_or_end_conf) of undefined -> - {timetrap_timeout,trunc(Timeout),Line}; + {timetrap_timeout,TruncTO,MFLs}; InitOrEnd -> - {timetrap_timeout,trunc(Timeout),Line,InitOrEnd} + {timetrap_timeout,TruncTO,MFLs,InitOrEnd} end, - exit(Pid,Trap), + exit(Pid, Trap), receive {'DOWN', Mon, process, Pid, _} -> ok diff --git a/lib/tv/src/tv_main.erl b/lib/tv/src/tv_main.erl index 2f743c2397..283ba4c967 100644 --- a/lib/tv/src/tv_main.erl +++ b/lib/tv/src/tv_main.erl @@ -312,7 +312,7 @@ analyze_error(Cause, Node, Table) -> handle_error(mnesia_not_started, Node, Table); {badrpc, {'EXIT', {aborted, {node_not_running,_ErrNode}}}} -> handle_error(mnesia_not_started, Node, Table); - {'EXIT', {undef, {mnesia,_Fcn,_Args}}} -> + {'EXIT', {undef, {mnesia,_Fcn,_Args,_}}} -> handle_error(mnesia_not_started, Node, Table); {'EXIT', Reason} -> diff --git a/lib/tv/src/tv_mnesia_rpc.erl b/lib/tv/src/tv_mnesia_rpc.erl index a2385714ec..4a75994145 100644 --- a/lib/tv/src/tv_mnesia_rpc.erl +++ b/lib/tv/src/tv_mnesia_rpc.erl @@ -87,6 +87,8 @@ chk(Result) -> throw(mnesia_not_started); {badrpc, _Reason} -> throw(mnesia_not_started); + {'EXIT', {undef, {mnesia,_Fcn,_Args,_}}} -> + throw(mnesia_not_started); {'EXIT', {undef, {mnesia,_Fcn,_Args}}} -> throw(mnesia_not_started); diff --git a/lib/wx/src/wx_object.erl b/lib/wx/src/wx_object.erl index bfd38960dd..82c4cfbad5 100644 --- a/lib/wx/src/wx_object.erl +++ b/lib/wx/src/wx_object.erl @@ -537,16 +537,16 @@ error_info(_Reason, application_controller, _Msg, _State, _Debug) -> error_info(Reason, Name, Msg, State, Debug) -> Reason1 = case Reason of - {undef,[{M,F,A}|MFAs]} -> + {undef,[{M,F,A,L}|MFAs]} -> case code:is_loaded(M) of false -> - {'module could not be loaded',[{M,F,A}|MFAs]}; + {'module could not be loaded',[{M,F,A,L}|MFAs]}; _ -> case erlang:function_exported(M, F, length(A)) of true -> Reason; false -> - {'function not exported',[{M,F,A}|MFAs]} + {'function not exported',[{M,F,A,L}|MFAs]} end end; _ -> diff --git a/lib/xmerl/src/xmerl.erl b/lib/xmerl/src/xmerl.erl index cf78f7bdf7..2332517988 100644 --- a/lib/xmerl/src/xmerl.erl +++ b/lib/xmerl/src/xmerl.erl @@ -307,7 +307,7 @@ apply_cb(Ms, F, Df, Args) -> apply_cb([M|Ms], F, Df, Args, Ms0) -> case catch apply(M, F, Args) of - {'EXIT', {undef,[{M,F,_}|_]}} -> + {'EXIT', {undef,[{M,F,_,_}|_]}} -> apply_cb(Ms, F, Df, Args, Ms0); {'EXIT', Reason} -> exit(Reason); |