diff options
56 files changed, 1104 insertions, 688 deletions
diff --git a/HOWTO/DTRACE.md b/HOWTO/DTRACE.md index 8fa2fd9d50..90f4addefd 100644 --- a/HOWTO/DTRACE.md +++ b/HOWTO/DTRACE.md @@ -27,12 +27,10 @@ Goals Supported platforms ------------------- -* OS X 10.6.x / Snow Leopard. It should also work for 10.7 / Lion, - but I haven't personally tested it. +* OS X 10.6.x / Snow Leopard, OS X 10.7.x / Lion and probably newer versions. * Solaris 10. I have done limited testing on Solaris 11 and OpenIndiana release 151a, and both appear to work. -* FreeBSD 9.0, though please see the "FreeBSD 9.0 Release Notes" - section below! +* FreeBSD 9.0 and 10.0. * Linux via SystemTap compatibility. Please see [$ERL_TOP/HOWTO/SYSTEMTAP.md][] for more details. diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex c940cf7eed..8c685feb27 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/compile.beam b/bootstrap/lib/compiler/ebin/compile.beam Binary files differindex 4e4f3cf4b7..1aa96eb292 100644 --- a/bootstrap/lib/compiler/ebin/compile.beam +++ b/bootstrap/lib/compiler/ebin/compile.beam diff --git a/bootstrap/lib/compiler/ebin/v3_core.beam b/bootstrap/lib/compiler/ebin/v3_core.beam Binary files differindex 89eb5bb272..52a1086004 100644 --- a/bootstrap/lib/compiler/ebin/v3_core.beam +++ b/bootstrap/lib/compiler/ebin/v3_core.beam diff --git a/bootstrap/lib/kernel/ebin/application.beam b/bootstrap/lib/kernel/ebin/application.beam Binary files differindex 7e2e98d5ab..2c8444fb95 100644 --- a/bootstrap/lib/kernel/ebin/application.beam +++ b/bootstrap/lib/kernel/ebin/application.beam diff --git a/bootstrap/lib/kernel/ebin/application_controller.beam b/bootstrap/lib/kernel/ebin/application_controller.beam Binary files differindex 590b9a54b0..659f29e35e 100644 --- a/bootstrap/lib/kernel/ebin/application_controller.beam +++ b/bootstrap/lib/kernel/ebin/application_controller.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam Binary files differindex c8f45fd838..0e72af0e35 100644 --- a/bootstrap/lib/stdlib/ebin/erl_expand_records.beam +++ b/bootstrap/lib/stdlib/ebin/erl_expand_records.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 4a45d59de6..301785992c 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/qlc_pt.beam b/bootstrap/lib/stdlib/ebin/qlc_pt.beam Binary files differindex 5c89047e67..f53c840702 100644 --- a/bootstrap/lib/stdlib/ebin/qlc_pt.beam +++ b/bootstrap/lib/stdlib/ebin/qlc_pt.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor.beam b/bootstrap/lib/stdlib/ebin/supervisor.beam Binary files differindex d1d1131c06..5fe8747341 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor.beam diff --git a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam Binary files differindex 6480117b9e..54d7385738 100644 --- a/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam +++ b/bootstrap/lib/stdlib/ebin/supervisor_bridge.beam diff --git a/erts/configure.in b/erts/configure.in index 8d245252b5..c20bb032f1 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -3848,28 +3848,26 @@ esac if test "$enable_dtrace_test" = "yes" ; then if test "$DTRACE" = "dtrace" ; then AC_CHECK_HEADERS(sys/sdt.h) + AC_MSG_CHECKING([for 1-stage DTrace precompilation]) # The OS X version of dtrace prints a spurious line here. if ! dtrace -h $DTRACE_CPP -Iemulator/beam -o ./foo-dtrace.h -s emulator/beam/erlang_dtrace.d; then AC_MSG_ERROR([Could not precompile erlang_dtrace.d: dtrace -h failed]) fi + AC_MSG_RESULT([yes]) - $RM -f dtest.{o,c} - cat > dtest.c <<_DTEST - #include "foo-dtrace.h" - int main(void) { ERLANG_DIST_PORT_BUSY_ENABLED(); return 0; } -_DTEST - $CC $CFLAGS -c -o dtest.o dtest.c - - $RM -f $DTRACE_2STEP_TEST - if dtrace -G $DTRACE_CPP $DTRACE_BITS_FLAG -Iemulator/beam -o $DTRACE_2STEP_TEST -s emulator/beam/erlang_dtrace.d dtest.o && \ - test -f $DTRACE_2STEP_TEST ; then - rm $DTRACE_2STEP_TEST + AC_MSG_CHECKING([for 2-stage DTrace precompilation]) + AC_TRY_COMPILE([ #include "foo-dtrace.h" ], + [ERLANG_DIST_PORT_BUSY_ENABLED();], + [$RM -f $DTRACE_2STEP_TEST + dtrace -G $DTRACE_CPP $DTRACE_BITS_FLAG -Iemulator/beam -o $DTRACE_2STEP_TEST -s emulator/beam/erlang_dtrace.d conftest.$OBJEXT 2>&AS_MESSAGE_LOG_FD + if test -f $DTRACE_2STEP_TEST; then + rm $DTRACE_2STEP_TEST DTRACE_ENABLED_2STEP=yes - AC_MSG_NOTICE([dtrace precompilation for 2-stage DTrace successful]) - else - AC_MSG_NOTICE([dtrace precompilation for 1-stage DTrace successful]) - fi - $RM -f dtest.{o,c} foo-dtrace.h + fi], + []) + AS_IF([test "x$DTRACE_ENABLED_2STEP" = "xyes"], + [AC_MSG_RESULT([yes])], + [AC_MSG_RESULT([no])]) DTRACE_ENABLED=yes case $OPSYS in diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index f88a4ccc24..74e0d26cff 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -513,10 +513,9 @@ ifdef DTRACE_ENABLED # global.h causes problems by including dtrace-wrapper.h which includes # the autogenerated erlang_dtrace.h ... so make erlang_dtrace.h very early. DTRACE_HEADERS = $(TARGET)/erlang_dtrace.h -generate: $(DTRACE_HEADERS) $(GENERATE) +GENERATE+= $(DTRACE_HEADERS) else DTRACE_HEADERS = -generate: $(GENERATE) endif ifdef HIPE_ENABLED diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index b589d1c930..915af7fbb1 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. 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 @@ -409,7 +409,7 @@ typedef struct LoaderState { __result = __result << 8 | *Stp->file_p++; \ } \ Dest = __result; \ - } while (0) + } #define GetByte(Stp, Dest) \ if ((Stp)->file_left < 1) { \ diff --git a/erts/emulator/beam/erl_db.c b/erts/emulator/beam/erl_db.c index 41e64fcd4f..a5d67571e2 100644 --- a/erts/emulator/beam/erl_db.c +++ b/erts/emulator/beam/erl_db.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. 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 @@ -125,6 +125,7 @@ get_meta_main_tab_lock(unsigned slot) static erts_smp_spinlock_t meta_main_tab_main_lock; static Uint meta_main_tab_first_free; /* Index of first free slot */ static int meta_main_tab_cnt; /* Number of active tables */ +static int meta_main_tab_top; /* Highest ever used slot + 1 */ static Uint meta_main_tab_slot_mask; /* The slot index part of an unnamed table id */ static Uint meta_main_tab_seq_incr; static Uint meta_main_tab_seq_cnt = 0; /* To give unique(-ish) table identifiers */ @@ -1469,6 +1470,10 @@ BIF_RETTYPE ets_new_2(BIF_ALIST_2) ASSERT(slot>=0 && slot<db_max_tabs); meta_main_tab_first_free = GET_NEXT_FREE_SLOT(slot); meta_main_tab_cnt++; + if (slot >= meta_main_tab_top) { + ASSERT(slot == meta_main_tab_top); + meta_main_tab_top = slot + 1; + } if (is_named) { ret = BIF_ARG_1; @@ -2058,27 +2063,31 @@ BIF_RETTYPE ets_all_0(BIF_ALIST_0) { DbTable* tb; Eterm previous; - int i, j; + int i; Eterm* hp; Eterm* hendp; int t_tabs_cnt; - int t_max_tabs; + int t_top; erts_smp_spin_lock(&meta_main_tab_main_lock); t_tabs_cnt = meta_main_tab_cnt; - t_max_tabs = db_max_tabs; + t_top = meta_main_tab_top; erts_smp_spin_unlock(&meta_main_tab_main_lock); hp = HAlloc(BIF_P, 2*t_tabs_cnt); hendp = hp + 2*t_tabs_cnt; previous = NIL; - j = 0; - for(i = 0; (i < t_max_tabs && j < t_tabs_cnt); i++) { + for(i = 0; i < t_top; i++) { erts_smp_rwmtx_t *mmtl = get_meta_main_tab_lock(i); erts_smp_rwmtx_rlock(mmtl); if (IS_SLOT_ALIVE(i)) { - j++; + if (hp == hendp) { + /* Racing table creator, grab some more heap space */ + t_tabs_cnt = 10; + hp = HAlloc(BIF_P, 2*t_tabs_cnt); + hendp = hp + 2*t_tabs_cnt; + } tb = meta_main_tab[i].u.tb; previous = CONS(hp, tb->common.id, previous); hp += 2; @@ -2849,6 +2858,7 @@ void init_db(void) ERTS_ETS_MISC_MEM_ADD(size); meta_main_tab_cnt = 0; + meta_main_tab_top = 0; for (i=1; i<db_max_tabs; i++) { SET_NEXT_FREE_SLOT(i-1,i); } diff --git a/erts/emulator/beam/erl_nif.c b/erts/emulator/beam/erl_nif.c index c35f1fc2c6..4126df6f34 100644 --- a/erts/emulator/beam/erl_nif.c +++ b/erts/emulator/beam/erl_nif.c @@ -1237,6 +1237,19 @@ static void steal_resource_type(ErlNifResourceType* type) } } +/* The opened_rt_list is used by enif_open_resource_type() + * in order to rollback "creates" and "take-overs" in case the load fails. + */ +struct opened_resource_type +{ + struct opened_resource_type* next; + + ErlNifResourceFlags op; + ErlNifResourceType* type; + ErlNifResourceDtor* new_dtor; +}; +static struct opened_resource_type* opened_rt_list = NULL; + ErlNifResourceType* enif_open_resource_type(ErlNifEnv* env, const char* module_str, @@ -1258,22 +1271,21 @@ enif_open_resource_type(ErlNifEnv* env, if (type == NULL) { if (flags & ERL_NIF_RT_CREATE) { type = erts_alloc(ERTS_ALC_T_NIF, - sizeof(struct enif_resource_type_t)); - type->dtor = dtor; + sizeof(struct enif_resource_type_t)); type->module = module_am; type->name = name_am; erts_refc_init(&type->refc, 1); - type->owner = env->mod_nif; - type->prev = &resource_type_list; - type->next = resource_type_list.next; - type->next->prev = type; - type->prev->next = type; op = ERL_NIF_RT_CREATE; + #ifdef DEBUG + type->dtor = (void*)1; + type->owner = (void*)2; + type->prev = (void*)3; + type->next = (void*)4; + #endif } } else { - if (flags & ERL_NIF_RT_TAKEOVER) { - steal_resource_type(type); + if (flags & ERL_NIF_RT_TAKEOVER) { op = ERL_NIF_RT_TAKEOVER; } else { @@ -1281,12 +1293,13 @@ enif_open_resource_type(ErlNifEnv* env, } } if (type != NULL) { - type->owner = env->mod_nif; - type->dtor = dtor; - if (type->dtor != NULL) { - erts_refc_inc(&type->owner->rt_dtor_cnt, 1); - } - erts_refc_inc(&type->owner->rt_cnt, 1); + struct opened_resource_type* ort = erts_alloc(ERTS_ALC_T_TMP, + sizeof(struct opened_resource_type)); + ort->op = op; + ort->type = type; + ort->new_dtor = dtor; + ort->next = opened_rt_list; + opened_rt_list = ort; } if (tried != NULL) { *tried = op; @@ -1294,6 +1307,51 @@ enif_open_resource_type(ErlNifEnv* env, return type; } +static void commit_opened_resource_types(struct erl_module_nif* lib) +{ + while (opened_rt_list) { + struct opened_resource_type* ort = opened_rt_list; + + ErlNifResourceType* type = ort->type; + + if (ort->op == ERL_NIF_RT_CREATE) { + type->prev = &resource_type_list; + type->next = resource_type_list.next; + type->next->prev = type; + type->prev->next = type; + } + else { /* ERL_NIF_RT_TAKEOVER */ + steal_resource_type(type); + } + + type->owner = lib; + type->dtor = ort->new_dtor; + + if (type->dtor != NULL) { + erts_refc_inc(&lib->rt_dtor_cnt, 1); + } + erts_refc_inc(&lib->rt_cnt, 1); + + opened_rt_list = ort->next; + erts_free(ERTS_ALC_T_TMP, ort); + } +} + +static void rollback_opened_resource_types(void) +{ + while (opened_rt_list) { + struct opened_resource_type* ort = opened_rt_list; + + if (ort->op == ERL_NIF_RT_CREATE) { + erts_free(ERTS_ALC_T_NIF, ort->type); + } + + opened_rt_list = ort->next; + erts_free(ERTS_ALC_T_TMP, ort); + } +} + + static void nif_resource_dtor(Binary* bin) { ErlNifResource* resource = (ErlNifResource*) ERTS_MAGIC_BIN_DATA(bin); @@ -1319,6 +1377,8 @@ void* enif_alloc_resource(ErlNifResourceType* type, size_t size) { Binary* bin = erts_create_magic_binary(SIZEOF_ErlNifResource(size), &nif_resource_dtor); ErlNifResource* resource = ERTS_MAGIC_BIN_DATA(bin); + + ASSERT(type->owner && type->next && type->prev); /* not allowed in load/upgrade */ resource->type = type; erts_refc_inc(&bin->refc, 1); #ifdef DEBUG @@ -2040,9 +2100,15 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) lib->entry = entry; erts_refc_init(&lib->rt_cnt, 0); erts_refc_init(&lib->rt_dtor_cnt, 0); + ASSERT(opened_rt_list == NULL); lib->mod = mod; env.mod_nif = lib; - if (mod->curr.nif != NULL) { /* Reload */ + if (mod->curr.nif != NULL) { /*************** Reload ******************/ + /* + * Repeated load_nif calls from same Erlang module instance ("reload") + * is deprecated and was only ment as a development feature not to + * be used in production systems. (See warning below) + */ int k; lib->priv_data = mod->curr.nif->priv_data; @@ -2074,6 +2140,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) ret = load_nif_error(BIF_P, reload, "Library reload-call unsuccessful."); } else { + commit_opened_resource_types(lib); mod->curr.nif->entry = NULL; /* to prevent 'unload' callback */ erts_unload_nif(mod->curr.nif); reload_warning = 1; @@ -2081,7 +2148,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) } else { lib->priv_data = NULL; - if (mod->old.nif != NULL) { /* Upgrade */ + if (mod->old.nif != NULL) { /**************** Upgrade ***************/ void* prev_old_data = mod->old.nif->priv_data; if (entry->upgrade == NULL) { ret = load_nif_error(BIF_P, upgrade, "Upgrade not supported by this NIF library."); @@ -2094,17 +2161,18 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) mod->old.nif->priv_data = prev_old_data; ret = load_nif_error(BIF_P, upgrade, "Library upgrade-call unsuccessful."); } - /*else if (mod->old_nif->priv_data != prev_old_data) { - refresh_cached_nif_data(mod->old_code, mod->old_nif); - }*/ + else + commit_opened_resource_types(lib); } - else if (entry->load != NULL) { /* Initial load */ + else if (entry->load != NULL) { /********* Initial load ***********/ erts_pre_nif(&env, BIF_P, lib); veto = entry->load(&env, &lib->priv_data, BIF_ARG_2); erts_post_nif(&env); if (veto) { ret = load_nif_error(BIF_P, "load", "Library load-call unsuccessful."); } + else + commit_opened_resource_types(lib); } } if (ret == am_ok) { @@ -2133,6 +2201,7 @@ BIF_RETTYPE load_nif_2(BIF_ALIST_2) } else { error: + rollback_opened_resource_types(); ASSERT(ret != am_ok); if (lib != NULL) { erts_free(ERTS_ALC_T_NIF, lib); diff --git a/erts/emulator/sys/unix/sys.c b/erts/emulator/sys/unix/sys.c index a5294ad84e..865cb50a56 100644 --- a/erts/emulator/sys/unix/sys.c +++ b/erts/emulator/sys/unix/sys.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. 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 @@ -2561,7 +2561,7 @@ void *erts_sys_aligned_alloc(UWord alignment, UWord size) #ifdef HAVE_POSIX_MEMALIGN void *ptr = NULL; int error; - ASSERT(alignment && (alignment & ~alignment) == 0); /* power of 2 */ + ASSERT(alignment && (alignment & (alignment-1)) == 0); /* power of 2 */ error = posix_memalign(&ptr, (size_t) alignment, (size_t) size); #if HAVE_ERTS_MSEG if (error || !ptr) { @@ -2584,7 +2584,7 @@ void *erts_sys_aligned_alloc(UWord alignment, UWord size) void erts_sys_aligned_free(UWord alignment, void *ptr) { - ASSERT(alignment && (alignment & ~alignment) == 0); /* power of 2 */ + ASSERT(alignment && (alignment & (alignment-1)) == 0); /* power of 2 */ free(ptr); } diff --git a/erts/emulator/sys/win32/sys.c b/erts/emulator/sys/win32/sys.c index 5ea4703a7a..a11ac73ebc 100755 --- a/erts/emulator/sys/win32/sys.c +++ b/erts/emulator/sys/win32/sys.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 1996-2013. All Rights Reserved. + * Copyright Ericsson AB 1996-2014. 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 @@ -2757,7 +2757,7 @@ void erts_sys_free(ErtsAlcType_t t, void *x, void *p) void *erts_sys_aligned_alloc(UWord alignment, UWord size) { void *ptr; - ASSERT(alignment && (alignment & ~alignment) == 0); /* power of 2 */ + ASSERT(alignment && (alignment & (alignment-1)) == 0); /* power of 2 */ ptr = _aligned_malloc((size_t) size, (size_t) alignment); ASSERT(!ptr || (((UWord) ptr) & (alignment - 1)) == 0); return ptr; @@ -2765,14 +2765,14 @@ void *erts_sys_aligned_alloc(UWord alignment, UWord size) void erts_sys_aligned_free(UWord alignment, void *ptr) { - ASSERT(alignment && (alignment & ~alignment) == 0); /* power of 2 */ + ASSERT(alignment && (alignment & (alignment-1)) == 0); /* power of 2 */ _aligned_free(ptr); } void *erts_sys_aligned_realloc(UWord alignment, void *ptr, UWord size, UWord old_size) { void *new_ptr; - ASSERT(alignment && (alignment & ~alignment) == 0); /* power of 2 */ + ASSERT(alignment && (alignment & (alignment-1)) == 0); /* power of 2 */ new_ptr = _aligned_realloc(ptr, (size_t) size, (size_t) alignment); ASSERT(!new_ptr || (((UWord) new_ptr) & (alignment - 1)) == 0); return new_ptr; diff --git a/erts/emulator/test/driver_SUITE.erl b/erts/emulator/test/driver_SUITE.erl index 06211406b4..c62bc0c454 100644 --- a/erts/emulator/test/driver_SUITE.erl +++ b/erts/emulator/test/driver_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2014. 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 @@ -1945,6 +1945,14 @@ otp_9302(Config) when is_list(Config) -> end. thr_free_drv(Config) when is_list(Config) -> + case erlang:system_info(threads) of + false -> + {skipped, "No thread support"}; + true -> + thr_free_drv_do(Config) + end. + +thr_free_drv_do(Config) -> ?line Path = ?config(data_dir, Config), ?line erl_ddll:start(), ?line ok = load_driver(Path, thr_free_drv), diff --git a/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c b/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c index 7c144d20cf..ad29d17f06 100644 --- a/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c +++ b/erts/emulator/test/driver_SUITE_data/otp_9302_drv.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2011-2013. All Rights Reserved. + * Copyright Ericsson AB 2011-2014. 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 @@ -94,7 +94,7 @@ DRIVER_INIT(otp_9302_drv) static void stop(ErlDrvData drv_data) { Otp9302Data *data = (Otp9302Data *) drv_data; - if (!data->smp) + if (data->msgq.mtx) erl_drv_mutex_destroy(data->msgq.mtx); driver_free(data); } @@ -114,13 +114,16 @@ static ErlDrvData start(ErlDrvPort port, driver_system_info(&sys_info, sizeof(ErlDrvSysInfo)); data->smp = sys_info.smp_support; + data->msgq.mtx = NULL; if (!data->smp) { data->msgq.start = NULL; data->msgq.end = NULL; - data->msgq.mtx = erl_drv_mutex_create(""); - if (!data->msgq.mtx) { - driver_free(data); - return ERL_DRV_ERROR_GENERAL; + if (sys_info.thread_support) { + data->msgq.mtx = erl_drv_mutex_create(""); + if (!data->msgq.mtx) { + driver_free(data); + return ERL_DRV_ERROR_GENERAL; + } } } @@ -143,19 +146,22 @@ static void enqueue_reply(Otp9302AsyncData *adata) Otp9302MsgQ *msgq = adata->msgq; adata->next = NULL; adata->refc++; - erl_drv_mutex_lock(msgq->mtx); + if (msgq->mtx) + erl_drv_mutex_lock(msgq->mtx); if (msgq->end) msgq->end->next = adata; else msgq->end = msgq->start = adata; msgq->end = adata; - erl_drv_mutex_unlock(msgq->mtx); + if (msgq->mtx) + erl_drv_mutex_unlock(msgq->mtx); } static void dequeue_replies(Otp9302AsyncData *adata) { Otp9302MsgQ *msgq = adata->msgq; - erl_drv_mutex_lock(msgq->mtx); + if (msgq->mtx) + erl_drv_mutex_lock(msgq->mtx); if (--adata->refc == 0) driver_free(adata); while (msgq->start) { @@ -166,7 +172,8 @@ static void dequeue_replies(Otp9302AsyncData *adata) driver_free(adata); } msgq->start = msgq->end = NULL; - erl_drv_mutex_unlock(msgq->mtx); + if (msgq->mtx) + erl_drv_mutex_unlock(msgq->mtx); } static void async_invoke(void *data) diff --git a/erts/emulator/test/nif_SUITE.erl b/erts/emulator/test/nif_SUITE.erl index bcc1f9e5af..a854d3f05b 100644 --- a/erts/emulator/test/nif_SUITE.erl +++ b/erts/emulator/test/nif_SUITE.erl @@ -850,6 +850,138 @@ resource_takeover(Config) when is_list(Config) -> ?line ok = forget_resource(AN4), ?line [] = nif_mod_call_history(), + + %% + %% Test rollback after failed upgrade of same lib-version + %% + + {A5,BinA5} = make_resource(2, Holder, "A5"), + {NA5,BinNA5} = make_resource(0, Holder, "NA5"), + {AN5,_BinAN5} = make_resource(1, Holder, "AN5"), + + {A6,BinA6} = make_resource(2, Holder, "A6"), + {NA6,BinNA6} = make_resource(0, Holder, "NA6"), + {AN6,_BinAN6} = make_resource(1, Holder, "AN6"), + + {module,nif_mod} = erlang:load_module(nif_mod,ModBin), + undefined = nif_mod:lib_version(), + {error,{upgrade,_}} = + nif_mod:load_nif_lib(Config, 1, + [{resource_type, 4, ?RT_TAKEOVER, "resource_type_A",resource_dtor_B, + ?RT_TAKEOVER}, + {resource_type, 4, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",null, + ?RT_TAKEOVER}, + {resource_type, 4, ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, 4, ?RT_CREATE, "Mr Pink", resource_dtor_A, + ?RT_CREATE}, + + {return, 1} % FAIL + ]), + + undefined = nif_mod:lib_version(), + [{upgrade,1,5,105}] = nif_mod_call_history(), + + %% Make sure dtor was not changed (from A to B) + ok = forget_resource(A5), + [{{resource_dtor_A_v1,BinA5},1,6,106}] = nif_mod_call_history(), + + %% Make sure dtor was not nullified (from A to null) + ok = forget_resource(NA5), + [{{resource_dtor_A_v1,BinNA5},1,7,107}] = nif_mod_call_history(), + + %% Make sure dtor was not added (from null to A) + ok = forget_resource(AN5), + [] = nif_mod_call_history(), + + %% + %% Test rollback after failed upgrade of other lib-version + %% + + {error,{upgrade,_}} = + nif_mod:load_nif_lib(Config, 2, + [{resource_type, 4, ?RT_TAKEOVER, "resource_type_A",resource_dtor_B, + ?RT_TAKEOVER}, + {resource_type, 4, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",null, + ?RT_TAKEOVER}, + {resource_type, 4, ?RT_TAKEOVER, "resource_type_A_null",resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, null, ?RT_TAKEOVER, "Mr Pink", resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, 4, ?RT_CREATE, "Mr Pink", resource_dtor_A, + ?RT_CREATE}, + + {return, 1} % FAIL + ]), + + undefined = nif_mod:lib_version(), + [{upgrade,2,_,_}] = nif_mod_call_history(), + + %% Make sure dtor was not changed (from A to B) + ok = forget_resource(A6), + [{{resource_dtor_A_v1,BinA6},1,_,_}] = nif_mod_call_history(), + + %% Make sure dtor was not nullified (from A to null) + ok = forget_resource(NA6), + [{{resource_dtor_A_v1,BinNA6},1,_,_}] = nif_mod_call_history(), + + %% Make sure dtor was not added (from null to A) + ok = forget_resource(AN6), + [] = nif_mod_call_history(), + + %% + %% Test rolback after failed initial load + %% + false = code:purge(nif_mod), + [{unload,1,_,_}] = nif_mod_call_history(), + true = code:delete(nif_mod), + false = code:purge(nif_mod), + [] = nif_mod_call_history(), + + + {module,nif_mod} = erlang:load_module(nif_mod,ModBin), + undefined = nif_mod:lib_version(), + {error,{load,_}} = + nif_mod:load_nif_lib(Config, 1, + [{resource_type, null, ?RT_TAKEOVER, "resource_type_A",resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, 4, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A",null, + ?RT_CREATE}, + {resource_type, 4, ?RT_CREATE, "resource_type_A_null",resource_dtor_A, + ?RT_CREATE}, + {resource_type, 4, ?RT_CREATE, "Mr Pink", resource_dtor_A, + ?RT_CREATE}, + + {return, 1} % FAIL + ]), + + undefined = nif_mod:lib_version(), + ok = nif_mod:load_nif_lib(Config, 1, + [{resource_type, null, ?RT_TAKEOVER, "resource_type_A",resource_dtor_A, + ?RT_TAKEOVER}, + {resource_type, 0, ?RT_TAKEOVER bor ?RT_CREATE, "resource_type_null_A", + resource_dtor_A, ?RT_CREATE}, + + {resource_type, 1, ?RT_CREATE, "resource_type_A_null", null, + ?RT_CREATE}, + {resource_type, null, ?RT_TAKEOVER, "Mr Pink", resource_dtor_A, + ?RT_TAKEOVER}, + + {return, 0} % SUCCESS + ]), + + ?line hold_nif_mod_priv_data(nif_mod:get_priv_data_ptr()), + ?line [{load,1,1,101},{get_priv_data_ptr,1,2,102}] = nif_mod_call_history(), + + {NA7,BinNA7} = make_resource(0, Holder, "NA7"), + {AN7,BinAN7} = make_resource(1, Holder, "AN7"), + + ok = forget_resource(NA7), + [{{resource_dtor_A_v1,BinNA7},1,_,_}] = nif_mod_call_history(), + + ok = forget_resource(AN7), + [] = nif_mod_call_history(), + ?line true = lists:member(?MODULE, erlang:system_info(taints)), ?line true = lists:member(nif_mod, erlang:system_info(taints)), ?line verify_tmpmem(TmpMem), @@ -1406,7 +1538,7 @@ dirty_nif(Config) when is_list(Config) -> {skipped,"No dirty scheduler support"} end. -next_msg(Pid) -> +next_msg(_Pid) -> receive M -> M after 100 -> diff --git a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c index b550d1f16d..160f4843ad 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_SUITE.c +++ b/erts/emulator/test/nif_SUITE_data/nif_SUITE.c @@ -1477,7 +1477,6 @@ static ERL_NIF_TERM consume_timeslice_nif(ErlNifEnv* env, int argc, const ERL_NI { int percent; char atom[10]; - int do_repeat; if (!enif_get_int(env, argv[0], &percent) || !enif_get_atom(env, argv[1], atom, sizeof(atom), ERL_NIF_LATIN1)) { diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.c b/erts/emulator/test/nif_SUITE_data/nif_mod.c index e32d10057c..55a0d2ac4f 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.c +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2009-2010. All Rights Reserved. + * Copyright Ericsson AB 2009-2014. 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 @@ -41,6 +41,7 @@ static ERL_NIF_TERM am_null; static ERL_NIF_TERM am_resource_type; static ERL_NIF_TERM am_resource_dtor_A; static ERL_NIF_TERM am_resource_dtor_B; +static ERL_NIF_TERM am_return; static NifModPrivData* priv_data(ErlNifEnv* env) { @@ -54,6 +55,7 @@ static void init(ErlNifEnv* env) am_resource_type = enif_make_atom(env, "resource_type"); am_resource_dtor_A = enif_make_atom(env, "resource_dtor_A"); am_resource_dtor_B = enif_make_atom(env, "resource_dtor_B"); + am_return = enif_make_atom(env, "return"); } static void add_call_with_arg(ErlNifEnv* env, NifModPrivData* data, const char* func_name, @@ -105,19 +107,15 @@ static void resource_dtor_B(ErlNifEnv* env, void* a) } /* {resource_type, Ix|null, ErlNifResourceFlags in, "TypeName", dtor(A|B|null), ErlNifResourceFlags out}*/ -static void open_resource_type(ErlNifEnv* env, ERL_NIF_TERM op_tpl) +static void open_resource_type(ErlNifEnv* env, const ERL_NIF_TERM* arr) { NifModPrivData* data = priv_data(env); - const ERL_NIF_TERM* arr; - int arity; char rt_name[30]; union { ErlNifResourceFlags e; int i; } flags, exp_res, got_res; unsigned ix; ErlNifResourceDtor* dtor; ErlNifResourceType* got_ptr; - CHECK(enif_get_tuple(env, op_tpl, &arity, &arr)); - CHECK(arity == 6); CHECK(enif_is_identical(arr[0], am_resource_type)); CHECK(enif_get_int(env, arr[2], &flags.i)); CHECK(enif_get_string(env, arr[3], rt_name, sizeof(rt_name), ERL_NIF_LATIN1) > 0); @@ -147,18 +145,32 @@ static void open_resource_type(ErlNifEnv* env, ERL_NIF_TERM op_tpl) CHECK(got_res.e == exp_res.e); } -static void do_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info) +static void do_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info, int* retvalp) { NifModPrivData* data = priv_data(env); ERL_NIF_TERM head, tail; unsigned ix; + for (ix=0; ix<RT_MAX; ix++) { data->rt_arr[ix] = NULL; } for (head = load_info; enif_get_list_cell(env, head, &head, &tail); head = tail) { - - open_resource_type(env, head); + const ERL_NIF_TERM* arr; + int arity; + + CHECK(enif_get_tuple(env, head, &arity, &arr)); + switch (arity) { + case 6: + open_resource_type(env, arr); + break; + case 2: + CHECK(arr[0] == am_return); + CHECK(enif_get_int(env, arr[1], retvalp)); + break; + default: + CHECK(0); + } } CHECK(enif_is_empty_list(env, head)); } @@ -166,6 +178,7 @@ static void do_load_info(ErlNifEnv* env, ERL_NIF_TERM load_info) static int load(ErlNifEnv* env, void** priv, ERL_NIF_TERM load_info) { NifModPrivData* data; + int retval = 0; init(env); data = (NifModPrivData*) enif_alloc(sizeof(NifModPrivData)); @@ -177,38 +190,41 @@ static int load(ErlNifEnv* env, void** priv, ERL_NIF_TERM load_info) add_call(env, data, "load"); - do_load_info(env, load_info); - data->calls = 0; - return 0; + do_load_info(env, load_info, &retval); + if (retval) + NifModPrivData_release(data); + return retval; } static int reload(ErlNifEnv* env, void** priv, ERL_NIF_TERM load_info) { NifModPrivData* data = (NifModPrivData*) *priv; + int retval = 0; init(env); add_call(env, data, "reload"); - do_load_info(env, load_info); - return 0; + do_load_info(env, load_info, &retval); + return retval; } static int upgrade(ErlNifEnv* env, void** priv, void** old_priv_data, ERL_NIF_TERM load_info) { NifModPrivData* data = (NifModPrivData*) *old_priv_data; + int retval = 0; init(env); add_call(env, data, "upgrade"); data->ref_cnt++; *priv = *old_priv_data; - do_load_info(env, load_info); + do_load_info(env, load_info, &retval); - return 0; + return retval; } static void unload(ErlNifEnv* env, void* priv) { NifModPrivData* data = (NifModPrivData*) priv; - int is_last; + add_call(env, data, "unload"); NifModPrivData_release(data); } diff --git a/erts/emulator/test/nif_SUITE_data/nif_mod.h b/erts/emulator/test/nif_SUITE_data/nif_mod.h index cd0ecf4b54..fb14fee815 100644 --- a/erts/emulator/test/nif_SUITE_data/nif_mod.h +++ b/erts/emulator/test/nif_SUITE_data/nif_mod.h @@ -14,7 +14,6 @@ typedef struct call_info_t typedef struct { ErlNifMutex* mtx; - int calls; int ref_cnt; CallInfo* call_history; ErlNifResourceType* rt_arr[RT_MAX]; @@ -28,6 +27,11 @@ typedef struct enif_mutex_unlock((NMPD)->mtx); \ if (is_last) { \ enif_mutex_destroy((NMPD)->mtx); \ + while ((NMPD)->call_history) { \ + CallInfo* next = (NMPD)->call_history->next; \ + enif_free((NMPD)->call_history); \ + (NMPD)->call_history = next; \ + } \ enif_free((NMPD)); \ } \ }while (0) diff --git a/lib/asn1/src/asn1ct.erl b/lib/asn1/src/asn1ct.erl index 531a4935fe..30f493a2df 100644 --- a/lib/asn1/src/asn1ct.erl +++ b/lib/asn1/src/asn1ct.erl @@ -1040,7 +1040,7 @@ get_file_list1(Stream,Dir,Includes,Acc) -> Ret = io:get_line(Stream,''), case Ret of eof -> - file:close(Stream), + ok = file:close(Stream), lists:reverse(Acc); FileName -> SuffixedNameList = @@ -1926,8 +1926,9 @@ read_config_file(ModuleName) -> Includes = [I || {i,I} <- Options], read_config_file1(ModuleName,Includes); {error,Reason} -> - file:format_error(Reason), - throw({error,{"error reading asn1 config file",Reason}}) + Error = "error reading asn1 config file: " ++ + file:format_error(Reason), + throw({error,Error}) end. read_config_file1(ModuleName,[]) -> case filename:extension(ModuleName) of @@ -1945,8 +1946,9 @@ read_config_file1(ModuleName,[H|T]) -> {error,enoent} -> read_config_file1(ModuleName,T); {error,Reason} -> - file:format_error(Reason), - throw({error,{"error reading asn1 config file",Reason}}) + Error = "error reading asn1 config file: " ++ + file:format_error(Reason), + throw({error,Error}) end. get_config_info(CfgList,InfoType) -> diff --git a/lib/asn1/src/asn1ct_check.erl b/lib/asn1/src/asn1ct_check.erl index df034c96ad..b9f2cb876a 100644 --- a/lib/asn1/src/asn1ct_check.erl +++ b/lib/asn1/src/asn1ct_check.erl @@ -2464,7 +2464,7 @@ normalize_value(S0, Type, {'DEFAULT',Value}, NameList) -> {'BIT STRING',CType,_} -> normalize_bitstring(S,Value,CType); {'OCTET STRING',CType,_} -> - normalize_octetstring(S,Value,CType); + normalize_octetstring(S0, Value, CType); {'NULL',_CType,_} -> %%normalize_null(Value); 'NULL'; @@ -2612,20 +2612,9 @@ normalize_octetstring(S,Value,CType) -> fun normalize_octetstring/3,[]); {Name,String} when is_atom(Name) -> normalize_octetstring(S,String,CType); - List when is_list(List) -> - %% check if list elements are valid octet values - lists:map(fun([])-> ok; - (H)when H > 255-> - asn1ct:warning("not legal octet value ~p in OCTET STRING, ~p~n", - [H,List],S, - "not legal octet value ~p in OCTET STRING"); - (_)-> ok - end, List), - List; - Other -> - asn1ct:warning("unknown default value ~p~n",[Other],S, - "unknown default value"), - Value + _ -> + Item = S#state.value, + throw(asn1_error(S, Item, illegal_octet_string_value)) end. normalize_objectidentifier(S, Value) -> @@ -3091,7 +3080,6 @@ check_type(S=#state{recordtopname=TopName},Type,Ts) when is_record(Ts,type) -> Ct=maybe_illicit_implicit_tag(open_type,Tag), TempNewDef#newt{type='ASN1_OPEN_TYPE',tag=Ct}; 'INTEGER' -> - check_integer(S,[],Constr), TempNewDef#newt{tag= merge_tags(Tag,?TAG_PRIMITIVE(?N_INTEGER))}; @@ -3938,9 +3926,9 @@ check_constraint(S,{simpletable,Type}) -> #'Externaltypereference'{} -> ERef = check_externaltypereference(S,C), {simpletable,ERef#'Externaltypereference'.type}; - #type{def=#'Externaltypereference'{type=T}} -> - check_externaltypereference(S,C#type.def), - {simpletable,T}; + #type{def=#'Externaltypereference'{}=ExtTypeRef} -> + ERef = check_externaltypereference(S, ExtTypeRef), + {simpletable,ERef#'Externaltypereference'.type}; {valueset,#type{def=ERef=#'Externaltypereference'{}}} -> % this is an object set {_,TDef} = get_referenced_type(S,ERef), case TDef#typedef.typespec of @@ -6814,6 +6802,8 @@ asn1_error(#state{mname=Where}, Item, Error) -> format_error({already_defined,Name,PrevLine}) -> io_lib:format("the name ~p has already been defined at line ~p", [Name,PrevLine]); +format_error(illegal_octet_string_value) -> + "expecting a bstring or an hstring as value for an OCTET STRING"; format_error({invalid_fields,Fields,Obj}) -> io_lib:format("invalid ~s in ~p", [format_fields(Fields),Obj]); format_error({missing_mandatory_fields,Fields,Obj}) -> diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 71d870b4ce..4707e517b4 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -71,7 +71,7 @@ pgen_module(OutFile,Erules,Module, HrlGenerated = pgen_hrl(Erules,Module,TypeOrVal,Options,Indent), asn1ct_name:start(), ErlFile = lists:concat([OutFile,".erl"]), - open_output_file(ErlFile), + _ = open_output_file(ErlFile), asn1ct_func:start_link(), gen_head(Erules,Module,HrlGenerated), pgen_exports(Erules,Module,TypeOrVal), @@ -190,7 +190,7 @@ pgen_check_defaultval(Erules,Module) -> "********~n~n",[X]) end, lists:foreach(Fun,CheckObjects), - file:close(IoDevice); + ok = file:close(IoDevice); _ -> ok end, gen_check_defaultval(Erules,Module,CheckObjects). @@ -1124,7 +1124,7 @@ pgen_info() -> open_hrl(OutFile,Module) -> File = lists:concat([OutFile,".hrl"]), - open_output_file(File), + _ = open_output_file(File), gen_hrlhead(Module). %% EMIT functions ************************ diff --git a/lib/asn1/src/asn1ct_table.erl b/lib/asn1/src/asn1ct_table.erl index a5eb6d0413..2eca80eda3 100644 --- a/lib/asn1/src/asn1ct_table.erl +++ b/lib/asn1/src/asn1ct_table.erl @@ -22,34 +22,25 @@ %% Table abstraction module for ASN.1 compiler -export([new/1]). --export([new/2]). -export([new_reuse/1]). --export([new_reuse/2]). -export([exists/1]). -export([size/1]). -export([insert/2]). -export([lookup/2]). -export([match/2]). -export([to_list/1]). --export([delete/1]). % TODO: Remove (since we run in a separate process) +-export([delete/1]). -%% Always creates a new table -new(Table) -> new(Table, []). -new(Table, Options) -> - TableId = case get(Table) of - undefined -> - ets:new(Table, Options); - _ -> - delete(Table), - ets:new(Table, Options) - end, +%% Always create a new table. +new(Table) -> + undefined = get(Table), %Assertion. + TableId = ets:new(Table, []), put(Table, TableId). -%% Only create it if it doesn't exist yet -new_reuse(Table) -> new_reuse(Table, []). -new_reuse(Table, Options) -> - not exists(Table) andalso new(Table, Options). +%% Only create it if it doesn't exist yet. +new_reuse(Table) -> + not exists(Table) andalso new(Table). exists(Table) -> get(Table) =/= undefined. @@ -63,14 +54,17 @@ match(Table, MatchSpec) -> ets:match(get(Table), MatchSpec). to_list(Table) -> ets:tab2list(get(Table)). +%% Deleting tables is no longer strictly necessary since each compilation +%% runs in separate process, but it will reduce memory consumption +%% especially when many compilations are run in parallel. + delete(Tables) when is_list(Tables) -> [delete(T) || T <- Tables], true; delete(Table) when is_atom(Table) -> - case get(Table) of + case erase(Table) of undefined -> true; TableId -> - ets:delete(TableId), - erase(Table) + ets:delete(TableId) end. diff --git a/lib/asn1/src/asn1ct_tok.erl b/lib/asn1/src/asn1ct_tok.erl index 85199c65ec..33f4379173 100644 --- a/lib/asn1/src/asn1ct_tok.erl +++ b/lib/asn1/src/asn1ct_tok.erl @@ -36,7 +36,7 @@ process(Stream,Lno,R) -> process(io:get_line(Stream, ''), Stream,Lno+1,R). process(eof, Stream,Lno,R) -> - file:close(Stream), + ok = file:close(Stream), lists:flatten(lists:reverse([{'$end',Lno}|R])); diff --git a/lib/asn1/src/asn1ct_value.erl b/lib/asn1/src/asn1ct_value.erl index a86c963b9d..be8b967cf0 100644 --- a/lib/asn1/src/asn1ct_value.erl +++ b/lib/asn1/src/asn1ct_value.erl @@ -352,7 +352,7 @@ random_unnamed_bit_string(M, C) -> random(Upper) -> {A1,A2,A3} = erlang:now(), - random:seed(A1,A2,A3), + _ = random:seed(A1, A2, A3), random:uniform(Upper). size_random(C) -> diff --git a/lib/asn1/test/error_SUITE.erl b/lib/asn1/test/error_SUITE.erl index 6451f81c01..930b44cea6 100644 --- a/lib/asn1/test/error_SUITE.erl +++ b/lib/asn1/test/error_SUITE.erl @@ -19,7 +19,7 @@ -module(error_SUITE). -export([suite/0,all/0,groups/0, - already_defined/1,enumerated/1,objects/1]). + already_defined/1,enumerated/1,objects/1,values/1]). -include_lib("test_server/include/test_server.hrl"). @@ -29,9 +29,11 @@ all() -> [{group,p}]. groups() -> - [{p,parallel(),[already_defined, - enumerated, - objects]}]. + [{p,parallel(), + [already_defined, + enumerated, + objects, + values]}]. parallel() -> case erlang:system_info(schedulers) > 1 of @@ -138,6 +140,25 @@ objects(Config) -> } = run(P, Config), ok. +values(Config) -> + M = 'Values', + P = {M, + <<"Values DEFINITIONS AUTOMATIC TAGS ::= BEGIN\n" + " os1 OCTET STRING ::= \"abc\"\n" + " os2 OCTET STRING ::= 42\n" + " os3 OCTET STRING ::= { 1, 3 }\n" + "END\n">>}, + {error, + [ + {structured_error,{M,2},asn1ct_check, + illegal_octet_string_value}, + {structured_error,{M,3},asn1ct_check, + illegal_octet_string_value}, + {structured_error,{M,4},asn1ct_check, + illegal_octet_string_value} + ] + } = run(P, Config), + ok. run({Mod,Spec}, Config) -> diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index ec5deb6905..3435a46ca9 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -101,6 +101,8 @@ -record(ireceive2, {anno=#a{},clauses,timeout,action}). -record(iset, {anno=#a{},var,arg}). -record(itry, {anno=#a{},args,vars,body,evars,handler}). +-record(ifilter, {anno=#a{},arg}). +-record(igen, {anno=#a{},acc_pat,acc_guard,skip_pat,tail,tail_pat,arg}). -type iapply() :: #iapply{}. -type ibinary() :: #ibinary{}. @@ -117,10 +119,13 @@ -type ireceive2() :: #ireceive2{}. -type iset() :: #iset{}. -type itry() :: #itry{}. +-type ifilter() :: #ifilter{}. +-type igen() :: #igen{}. -type i() :: iapply() | ibinary() | icall() | icase() | icatch() | iclause() | ifun() | iletrec() | imatch() | iprimop() - | iprotect() | ireceive1() | ireceive2() | iset() | itry(). + | iprotect() | ireceive1() | ireceive2() | iset() | itry() + | ifilter() | igen(). -type warning() :: {file:filename(), [{integer(), module(), term()}]}. @@ -479,8 +484,9 @@ expr({cons,L,H0,T0}, St0) -> {T1,Tps,St2} = safe(T0, St1), A = lineno_anno(L, St2), {ann_c_cons(A, H1, T1),Hps ++ Tps,St2}; -expr({lc,L,E,Qs}, St) -> - lc_tq(L, E, Qs, #c_literal{anno=lineno_anno(L, St),val=[]}, St); +expr({lc,L,E,Qs0}, St0) -> + {Qs1,St1} = preprocess_quals(L, Qs0, St0), + lc_tq(L, E, Qs1, #c_literal{anno=lineno_anno(L, St1),val=[]}, St1); expr({bc,L,E,Qs}, St) -> bc_tq(L, E, Qs, {nil,L}, St); expr({tuple,L,Es0}, St0) -> @@ -647,7 +653,7 @@ expr({match,L,P0,E0}, St0) -> Other when not is_atom(Other) -> {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4} end; -expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) -> +expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> %% Optimise '++' here because of the list comprehension algorithm. %% %% To avoid achieving quadratic complexity if there is a chain of @@ -655,7 +661,8 @@ expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) -> %% evaluation of More now. Evaluating More here could also reduce the %% number variables in the environment for letrec. {Mc,Mps,St1} = safe(More, St0), - {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St1), + {Qs,St2} = preprocess_quals(Llc, Qs0, St1), + {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St2), {Y,Mps++Yps,St}; expr({op,L,'andalso',E1,E2}, St0) -> {#c_var{name=V0},St} = new_var(L, St0), @@ -889,136 +896,45 @@ fun_tq({_,_,Name}=Id, Cs0, L, St0, NameInfo) -> %% lc_tq(Line, Exp, [Qualifier], Mc, State) -> {LetRec,[PreExp],State}. %% This TQ from Simon PJ pp 127-138. -%% This gets a bit messy as we must transform all directly here. We -%% recognise guard tests and try to fold them together and join to a -%% preceding generators, this should give us better and more compact -%% code. -lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], Mc, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), +lc_tq(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard, + skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, + arg={Pre,Arg}}|Qs], Mc, St0) -> {Name,St1} = new_fun_name("lc", St0), - {Head,St2} = new_var(St1), - {Tname,St3} = new_var_name(St2), - LA = lineno_anno(Line, St3), - CGAnno = #a{anno=[list_comprehension|LA]}, - LAnno = #a{anno=LA}, - Tail = #c_var{anno=LA,name=Tname}, - {Arg,St4} = new_var(St3), - {Nc,[],St5} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St4), - {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat! - {Lc,Lps,St7} = lc_tq(Line, E, Qs1, Nc, St6), - {Pc,St8} = list_gen_pattern(P, Line, St7), - {Gc,Gps,St9} = safe(G, St8), %Will be a function argument! - Fc = function_clause([Arg], LA, {Name,1}), - - %% Avoid constructing a default clause if the list comprehension - %% only has a variable as generator and there are no guard - %% tests. In other words, if the comprehension is equivalent to - %% lists:map/2. - Cs0 = case {Guardc, Pc} of - {[], #c_var{}} -> - [#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]}],guard=[], - body=[Mc]}]; - _ -> - [#iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[ann_c_cons(LA, Head, Tail)], - guard=[], - body=[Nc]}, - #iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]}],guard=[], - body=[Mc]}] - end, - Cs = case Pc of - nomatch -> Cs0; - _ -> - [#iclause{anno=LAnno, - pats=[ann_c_cons(LA, Pc, Tail)], - guard=Guardc, - body=Lps ++ [Lc]}|Cs0] - end, - Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc}, - {#iletrec{anno=CGAnno,defs=[{{Name,1},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,1}}, - args=[Gc]}]}, - [],St9}; -lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Name,St1} = new_fun_name("blc", St0), LA = lineno_anno(Line, St1), LAnno = #a{anno=LA}, - CGAnno = #a{anno=[list_comprehension|LA]}, - HeadBinPattern = pattern(P, St1), - #c_binary{segments=Ps0} = HeadBinPattern, - {Ps,Tail,St2} = append_tail_segment(Ps0, St1), - {EPs,St3} = emasculate_segments(Ps, St2), - Pattern = HeadBinPattern#c_binary{segments=Ps}, - EPattern = HeadBinPattern#c_binary{segments=EPs}, - {Arg,St4} = new_var(St3), - {Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat! - Tname = Tail#c_var.name, - {Nc,[],St6} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St5), - {Bc,Bps,St7} = lc_tq(Line, E, Qs1, Nc, St6), - {Gc,Gps,St10} = safe(G, St7), %Will be a function argument! - Fc = function_clause([Arg], LA, {Name,1}), - {TailSegList,_,St} = append_tail_segment([], St10), - Cs = [#iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[Pattern], - guard=Guardc, - body=Bps ++ [Bc]}, - #iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[EPattern], - guard=[], - body=[#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,1}}, - args=[Tail]}]}, - #iclause{anno=LAnno, - pats=[#c_binary{anno=LA,segments=TailSegList}],guard=[], - body=[Mc]}], - Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc}, - {#iletrec{anno=CGAnno,defs=[{{Name,1},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,1}}, - args=[Gc]}]}, - [],St}; -lc_tq(Line, E, [Fil0|Qs0], Mc, St0) -> - %% Special case sequences guard tests. - LA = lineno_anno(element(2, Fil0), St0), - LAnno = #a{anno=LA}, - CGAnno = #a{anno=[list_comprehension|LA]}, - case is_guard_test(Fil0) of - true -> - {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Lc,Lps,St1} = lc_tq(Line, E, Qs1, Mc, St0), - {Gs,St2} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat! - {#icase{anno=CGAnno, - args=[], - clauses=[#iclause{anno=LAnno,pats=[], - guard=Gs,body=Lps ++ [Lc]}], - fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[],guard=[],body=[Mc]}}, - [],St2}; - false -> - {Lc,Lps,St1} = lc_tq(Line, E, Qs0, Mc, St0), - {Fpat,St2} = new_var(St1), - 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=CGAnno, - args=[Filc], - clauses=[#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=true}], - guard=[], - body=Lps ++ [Lc]}, - #iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[#c_literal{anno=LA,val=false}], - guard=[], - body=[Mc]}], - fc=Fc}, - Fps,St3} - end; + F = #c_var{anno=LA,name={Name,1}}, + Nc = #iapply{anno=GAnno,op=F,args=[Tail]}, + {Var,St2} = new_var(St1), + Fc = function_clause([Var], LA, {Name,1}), + TailClause = #iclause{anno=LAnno,pats=[TailPat],guard=[],body=[Mc]}, + Cs0 = case {AccPat,AccGuard} of + {SkipPat,[]} -> + %% Skip and accumulator patterns are the same and there is + %% no guard, no need to generate a skip clause. + [TailClause]; + _ -> + [#iclause{anno=#a{anno=[compiler_generated|LA]}, + pats=[SkipPat],guard=[],body=[Nc]}, + TailClause] + end, + {Cs,St4} = case AccPat of + nomatch -> + %% The accumulator pattern never matches, no need + %% for an accumulator clause. + {Cs0,St2}; + _ -> + {Lc,Lps,St3} = lc_tq(Line, E, Qs, Nc, St2), + {[#iclause{anno=LAnno,pats=[AccPat],guard=AccGuard, + body=Lps ++ [Lc]}|Cs0], + St3} + end, + Fun = #ifun{anno=LAnno,id=[],vars=[Var],clauses=Cs,fc=Fc}, + {#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,1},Fun}], + body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg]}]}, + [],St4}; +lc_tq(Line, E, [#ifilter{}=Filter|Qs], Mc, St) -> + filter_tq(Line, E, Filter, Mc, St, Qs, fun lc_tq/5); lc_tq(Line, E0, [], Mc0, St0) -> {H1,Hps,St1} = safe(E0, St0), {T1,Tps,St} = force_safe(Mc0, St1), @@ -1028,146 +944,60 @@ lc_tq(Line, E0, [], Mc0, St0) -> %% bc_tq(Line, Exp, [Qualifier], More, State) -> {LetRec,[PreExp],State}. %% This TQ from Gustafsson ERLANG'05. -%% This gets a bit messy as we must transform all directly here. We -%% recognise guard tests and try to fold them together and join to a -%% preceding generators, this should give us better and more compact -%% code. %% More could be transformed before calling bc_tq. -bc_tq(Line, Exp, Qualifiers, _, St0) -> +bc_tq(Line, Exp, Qs0, _, St0) -> {BinVar,St1} = new_var(St0), - {Sz,SzPre,St2} = bc_initial_size(Exp, Qualifiers, St1), - {E,BcPre,St} = bc_tq1(Line, Exp, Qualifiers, BinVar, St2), + {Sz,SzPre,St2} = bc_initial_size(Exp, Qs0, St1), + {Qs,St3} = preprocess_quals(Line, Qs0, St2), + {E,BcPre,St} = bc_tq1(Line, Exp, Qs, BinVar, St3), Pre = SzPre ++ [#iset{var=BinVar, arg=#iprimop{name=#c_literal{val=bs_init_writable}, args=[Sz]}}] ++ BcPre, {E,Pre,St}. -bc_tq1(Line, E, [{generate,Lg,P,G}|Qs0], AccExpr, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Name,St1} = new_fun_name("lbc", St0), - LA = lineno_anno(Line, St1), - {[Head,Tail,AccVar],St2} = new_vars(LA, 3, St1), - LAnno = #a{anno=LA}, - CGAnno = #a{anno=[list_comprehension|LA]}, - {Arg,St3} = new_var(St2), - NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name}, - {var,Lg,AccVar#c_var.name}]}, - {Guardc,St4} = lc_guard_tests(Gs, St3), %These are always flat! - {Lc,Lps,St5} = bc_tq1(Line, E, Qs1, AccVar, St4), - {Nc,Nps,St6} = expr(NewMore, St5), - {Pc,St7} = list_gen_pattern(P, Line, St6), - {Gc,Gps,St8} = safe(G, St7), %Will be a function argument! - Fc = function_clause([Arg,AccVar], LA, {Name,2}), - Cs0 = case {Guardc, Pc} of - {[], #c_var{}} -> - [#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[], - body=[AccVar]}]; - _ -> - [#iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[ann_c_cons(LA, Head, Tail),AccVar], - guard=[], - body=Nps ++ [Nc]}, - #iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=[]},AccVar],guard=[], - body=[AccVar]}] - end, - Cs = case Pc of - nomatch -> Cs0; - _ -> - Body = Lps ++ Nps ++ [#iset{var=AccVar,arg=Lc},Nc], - [#iclause{anno=LAnno, - pats=[ann_c_cons(LA,Pc,Tail),AccVar], - guard=Guardc, - body=Body}|Cs0] - end, - Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc}, - {#iletrec{anno=CGAnno,defs=[{{Name,2},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,2}}, - args=[Gc,AccExpr]}]}, - [],St8}; -bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) -> - {Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0), +bc_tq1(Line, E, [#igen{anno=GAnno,acc_pat=AccPat,acc_guard=AccGuard, + skip_pat=SkipPat,tail=Tail,tail_pat=TailPat, + arg={Pre,Arg}}|Qs], Mc, St0) -> {Name,St1} = new_fun_name("lbc", St0), LA = lineno_anno(Line, St1), - {AccVar,St2} = new_var(LA, St1), LAnno = #a{anno=LA}, - CGAnno = #a{anno=[list_comprehension|LA]}, - HeadBinPattern = pattern(P, St2), - #c_binary{segments=Ps0} = HeadBinPattern, - {Ps,Tail,St3} = append_tail_segment(Ps0, St2), - {EPs,St4} = emasculate_segments(Ps, St3), - Pattern = HeadBinPattern#c_binary{segments=Ps}, - EPattern = HeadBinPattern#c_binary{segments=EPs}, - {Arg,St5} = new_var(St4), - NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name}, - {var,Lg,AccVar#c_var.name}]}, - {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat! - {Bc,Bps,St7} = bc_tq1(Line, E, Qs1, AccVar, St6), - {Nc,Nps,St8} = expr(NewMore, St7), - {Gc,Gps,St9} = safe(G, St8), %Will be a function argument! - Fc = function_clause([Arg,AccVar], LA, {Name,2}), - Body = Bps ++ Nps ++ [#iset{var=AccVar,arg=Bc},Nc], - {TailSegList,_,St} = append_tail_segment([], St9), - Cs = [#iclause{anno=LAnno, - pats=[Pattern,AccVar], - guard=Guardc, - body=Body}, - #iclause{anno=#a{anno=[compiler_generated|LA]}, - pats=[EPattern,AccVar], - guard=[], - body=Nps ++ [Nc]}, - #iclause{anno=LAnno, - pats=[#c_binary{anno=LA,segments=TailSegList},AccVar], - guard=[], - body=[AccVar]}], - Fun = #ifun{anno=CGAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc}, - {#iletrec{anno=LAnno,defs=[{{Name,2},Fun}], - body=Gps ++ [#iapply{anno=LAnno, - op=#c_var{anno=LA,name={Name,2}}, - args=[Gc,AccExpr]}]}, - [],St}; -bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) -> - %% Special case sequences guard tests. - LA = lineno_anno(element(2, Fil0), St0), - LAnno = #a{anno=LA}, - CGAnno = #a{anno=[list_comprehension|LA]}, - case is_guard_test(Fil0) of - true -> - {Gs0,Qs1} = splitwith(fun is_guard_test/1, Qs0), - {Bc,Bps,St1} = bc_tq1(Line, E, Qs1, AccVar, St0), - {Gs,St} = lc_guard_tests([Fil0|Gs0], St1), %These are always flat! - {#icase{anno=CGAnno, - args=[], - clauses=[#iclause{anno=LAnno, - pats=[], - guard=Gs,body=Bps ++ [Bc]}], - fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[],guard=[],body=[AccVar]}}, - [],St}; - false -> - {Bc,Bps,St1} = bc_tq1(Line, E, Qs0, AccVar, St0), - {Fpat,St2} = new_var(St1), - 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=CGAnno, - args=[Filc], - clauses=[#iclause{anno=LAnno, - pats=[#c_literal{anno=LA,val=true}], - guard=[], - body=Bps ++ [Bc]}, - #iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, - pats=[#c_literal{anno=LA,val=false}], - guard=[], - body=[AccVar]}], - fc=Fc}, - Fps,St} - end; + {Vars=[_,AccVar],St2} = new_vars(LA, 2, St1), + F = #c_var{anno=LA,name={Name,2}}, + Nc = #iapply{anno=GAnno,op=F,args=[Tail,AccVar]}, + Fc = function_clause(Vars, LA, {Name,2}), + TailClause = #iclause{anno=LAnno,pats=[TailPat,AccVar],guard=[], + body=[AccVar]}, + Cs0 = case {AccPat,AccGuard} of + {SkipPat,[]} -> + %% Skip and accumulator patterns are the same and there is + %% no guard, no need to generate a skip clause. + [TailClause]; + _ -> + [#iclause{anno=#a{anno=[compiler_generated|LA]}, + pats=[SkipPat,AccVar],guard=[],body=[Nc]}, + TailClause] + end, + {Cs,St4} = case AccPat of + nomatch -> + %% The accumulator pattern never matches, no need + %% for an accumulator clause. + {Cs0,St2}; + _ -> + {Bc,Bps,St3} = bc_tq1(Line, E, Qs, AccVar, St2), + Body = Bps ++ [#iset{var=AccVar,arg=Bc},Nc], + {[#iclause{anno=LAnno, + pats=[AccPat,AccVar],guard=AccGuard, + body=Body}|Cs0], + St3} + end, + Fun = #ifun{anno=LAnno,id=[],vars=Vars,clauses=Cs,fc=Fc}, + {#iletrec{anno=LAnno#a{anno=[list_comprehension|LA]},defs=[{{Name,2},Fun}], + body=Pre ++ [#iapply{anno=LAnno,op=F,args=[Arg,Mc]}]}, + [],St4}; +bc_tq1(Line, E, [#ifilter{}=Filter|Qs], Mc, St) -> + filter_tq(Line, E, Filter, Mc, St, Qs, fun bc_tq1/5); bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) -> {E,Pre,St} = expr({bin,Bl,[{bin_element,Bl, {var,Bl,AccVar#c_var.name}, @@ -1175,16 +1005,154 @@ bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) -> [binary,{unit,1}]}|Elements]}, St0), #a{anno=A} = Anno0 = get_anno(E), Anno = Anno0#a{anno=[compiler_generated,single_use|A]}, - %%Anno = Anno0#a{anno=[compiler_generated|A]}, {set_anno(E, Anno),Pre,St}. +%% filter_tq(Line, Expr, Filter, Mc, State, [Qualifier], TqFun) -> +%% {Case,[PreExpr],State}. +%% Transform an intermediate comprehension filter to its intermediate case +%% representation. + +filter_tq(Line, E, #ifilter{anno=#a{anno=LA}=LAnno,arg={Pre,Arg}}, + Mc, St0, Qs, TqFun) -> + %% The filter is an expression, it is compiled to a case of degree 1 with + %% 3 clauses, one accumulating, one skipping and the final one throwing + %% {case_clause,Value} where Value is the result of the filter and is not a + %% boolean. + {Lc,Lps,St1} = TqFun(Line, E, Qs, Mc, St0), + {FailPat,St2} = new_var(St1), + Fc = fail_clause([FailPat], LA, + c_tuple([#c_literal{val=case_clause},FailPat])), + {#icase{anno=LAnno#a{anno=[list_comprehension|LA]},args=[Arg], + clauses=[#iclause{anno=LAnno, + pats=[#c_literal{val=true}],guard=[], + body=Lps ++ [Lc]}, + #iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, + pats=[#c_literal{val=false}],guard=[], + body=[Mc]}], + fc=Fc}, + Pre,St2}; +filter_tq(Line, E, #ifilter{anno=#a{anno=LA}=LAnno,arg=Guard}, + Mc, St0, Qs, TqFun) when is_list(Guard) -> + %% Otherwise it is a guard, compiled to a case of degree 0 with 2 clauses, + %% the first matches if the guard succeeds and the comprehension continues + %% or the second one is selected and the current element is skipped. + {Lc,Lps,St1} = TqFun(Line, E, Qs, Mc, St0), + {#icase{anno=LAnno#a{anno=[list_comprehension|LA]},args=[], + clauses=[#iclause{anno=LAnno,pats=[],guard=Guard,body=Lps ++ [Lc]}], + fc=#iclause{anno=LAnno#a{anno=[compiler_generated|LA]}, + pats=[],guard=[],body=[Mc]}}, + [],St1}. + +%% preprocess_quals(Line, [Qualifier], State) -> {[Qualifier'],State}. +%% Preprocess a list of Erlang qualifiers into its intermediate representation, +%% represented as a list of #igen{} and #ifilter{} records. We recognise guard +%% tests and try to fold them together and join to a preceding generators, this +%% should give us better and more compact code. + +preprocess_quals(Line, Qs, St) -> + preprocess_quals(Line, Qs, St, []). + +preprocess_quals(Line, [Q|Qs0], St0, Acc) -> + case is_generator(Q) of + true -> + {Gs,Qs} = splitwith(fun is_guard_test/1, Qs0), + {Gen,St} = generator(Line, Q, Gs, St0), + preprocess_quals(Line, Qs, St, [Gen|Acc]); + false -> + LAnno = #a{anno=lineno_anno(get_anno(Q), St0)}, + case is_guard_test(Q) of + true -> + %% When a filter is a guard test, its argument in the + %% #ifilter{} record is a list as returned by + %% lc_guard_tests/2. + {Gs,Qs} = splitwith(fun is_guard_test/1, Qs0), + {Cg,St} = lc_guard_tests([Q|Gs], St0), + Filter = #ifilter{anno=LAnno,arg=Cg}, + preprocess_quals(Line, Qs, St, [Filter|Acc]); + false -> + %% Otherwise, it is a pair {Pre,Arg} as in a generator + %% input. + {Ce,Pre,St} = novars(Q, St0), + Filter = #ifilter{anno=LAnno,arg={Pre,Ce}}, + preprocess_quals(Line, Qs0, St, [Filter|Acc]) + end + end; +preprocess_quals(_, [], St, Acc) -> + {reverse(Acc),St}. + +is_generator({generate,_,_,_}) -> true; +is_generator({b_generate,_,_,_}) -> true; +is_generator(_) -> false. + +%% +%% Generators are abstracted as sextuplets: +%% - acc_pat is the accumulator pattern, e.g. [Pat|Tail] for Pat <- Expr. +%% - acc_guard is the list of guards immediately following the current +%% generator in the qualifier list input. +%% - skip_pat is the skip pattern, e.g. <<X,_:X,Tail/bitstring>> for +%% <<X,1:X>> <= Expr. +%% - tail is the variable used in AccPat and SkipPat bound to the rest of the +%% generator input. +%% - tail_pat is the tail pattern, respectively [] and <<_/bitstring>> for list +%% and bit string generators. +%% - arg is a pair {Pre,Arg} where Pre is the list of expressions to be +%% inserted before the comprehension function and Arg is the expression +%% that it should be passed. +%% + +%% generator(Line, Generator, Guard, State) -> {Generator',State}. +%% Transform a given generator into its #igen{} representation. + +generator(Line, {generate,Lg,P0,E}, Gs, St0) -> + LA = lineno_anno(Line, St0), + GA = lineno_anno(Lg, St0), + {Head,St1} = list_gen_pattern(P0, Line, St0), + {[Tail,Skip],St2} = new_vars(2, St1), + {Cg,St3} = lc_guard_tests(Gs, St2), + {AccPat,SkipPat} = case Head of + #c_var{} -> + %% If the generator pattern is a variable, the + %% pattern from the accumulator clause can be + %% reused in the skip one. lc_tq and bc_tq1 takes + %% care of dismissing the latter in that case. + Cons = ann_c_cons(LA, Head, Tail), + {Cons,Cons}; + nomatch -> + %% If it never matches, there is no need for + %% an accumulator clause. + {nomatch,ann_c_cons(LA, Skip, Tail)}; + _ -> + {ann_c_cons(LA, Head, Tail), + ann_c_cons(LA, Skip, Tail)} + end, + {Ce,Pre,St4} = safe(E, St3), + Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, + tail=Tail,tail_pat=#c_literal{anno=LA,val=[]},arg={Pre,Ce}}, + {Gen,St4}; +generator(Line, {b_generate,Lg,P,E}, Gs, St0) -> + LA = lineno_anno(Line, St0), + GA = lineno_anno(Lg, St0), + Cp = #c_binary{segments=Segs} = pattern(P, St0), + %% The function append_tail_segment/2 keeps variable patterns as-is, making + %% it possible to have the same skip clause removal as with list generators. + {AccSegs,Tail,TailSeg,St1} = append_tail_segment(Segs, St0), + AccPat = Cp#c_binary{segments=AccSegs}, + {Cg,St2} = lc_guard_tests(Gs, St1), + {SkipSegs,St3} = emasculate_segments(AccSegs, St2), + SkipPat = Cp#c_binary{segments=SkipSegs}, + {Ce,Pre,St4} = safe(E, St3), + Gen = #igen{anno=#a{anno=GA},acc_pat=AccPat,acc_guard=Cg,skip_pat=SkipPat, + tail=Tail,tail_pat=#c_binary{anno=LA,segments=[TailSeg]}, + arg={Pre,Ce}}, + {Gen,St4}. + append_tail_segment(Segs, St0) -> {Var,St} = new_var(St0), Tail = #c_bitstr{val=Var,size=#c_literal{val=all}, unit=#c_literal{val=1}, type=#c_literal{val=binary}, flags=#c_literal{val=[unsigned,big]}}, - {Segs++[Tail],Var,St}. + {Segs++[Tail],Var,Tail,St}. emasculate_segments(Segs, St) -> emasculate_segments(Segs, St, []). @@ -1195,7 +1163,7 @@ emasculate_segments([B|Rest], St0, Acc) -> {Var,St1} = new_var(St0), emasculate_segments(Rest, St1, [B#c_bitstr{val=Var}|Acc]); emasculate_segments([], St, Acc) -> - {lists:reverse(Acc),St}. + {reverse(Acc),St}. lc_guard_tests([], St) -> {[],St}; lc_guard_tests(Gs0, St0) -> diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 925ad0c091..2e1a21178f 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2010-2013. All Rights Reserved. + * Copyright Ericsson AB 2010-2014. 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 @@ -444,6 +444,15 @@ static ERL_NIF_TERM atom_ppbasis; static ERL_NIF_TERM atom_onbasis; #endif +static ErlNifResourceType* hmac_context_rtype; +struct hmac_context +{ + ErlNifMutex* mtx; + int alive; + HMAC_CTX ctx; +}; +static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*); + /* #define PRINTF_ERR0(FMT) enif_fprintf(stderr, FMT "\n") #define PRINTF_ERR1(FMT, A1) enif_fprintf(stderr, FMT "\n", A1) @@ -498,6 +507,15 @@ static int init(ErlNifEnv* env, ERL_NIF_TERM load_info) return 0; } + hmac_context_rtype = enif_open_resource_type(env, NULL, "hmac_context", + (ErlNifResourceDtor*) hmac_context_dtor, + ERL_NIF_RT_CREATE|ERL_NIF_RT_TAKEOVER, + NULL); + if (!hmac_context_rtype) { + PRINTF_ERR0("CRYPTO: Could not open resource type 'hmac_context'"); + return 0; + } + if (library_refc > 0) { /* Repeated loading of this library (module upgrade). * Atoms and callbacks are already set, we are done. @@ -1280,11 +1298,19 @@ static ERL_NIF_TERM sha512_mac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM #endif } +static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context *obj) +{ + if (obj->alive) { + HMAC_CTX_cleanup(&obj->ctx); + obj->alive = 0; + } + enif_mutex_destroy(obj->mtx); +} + static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type, Key) */ ErlNifBinary key; - ERL_NIF_TERM ret; - unsigned char * ctx_buf; + struct hmac_context* obj; const EVP_MD *md; if (argv[0] == atom_sha) md = EVP_sha1(); @@ -1309,57 +1335,60 @@ static ERL_NIF_TERM hmac_init(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[ return enif_make_badarg(env); } - ctx_buf = enif_make_new_binary(env, sizeof(HMAC_CTX), &ret); - HMAC_CTX_init((HMAC_CTX *) ctx_buf); - HMAC_Init((HMAC_CTX *) ctx_buf, key.data, key.size, md); + obj = enif_alloc_resource(hmac_context_rtype, sizeof(struct hmac_context)); + obj->mtx = enif_mutex_create("crypto.hmac"); + obj->alive = 1; + HMAC_CTX_init(&obj->ctx); + HMAC_Init(&obj->ctx, key.data, key.size, md); - return ret; + return enif_make_resource(env, obj); } static ERL_NIF_TERM hmac_update(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context, Data) */ - ErlNifBinary context, data; - ERL_NIF_TERM ret; - unsigned char * ctx_buf; + ErlNifBinary data; + struct hmac_context* obj; - if (!enif_inspect_binary(env, argv[0], &context) - || !enif_inspect_iolist_as_binary(env, argv[1], &data) - || context.size != sizeof(HMAC_CTX)) { + if (!enif_get_resource(env, argv[0], hmac_context_rtype, (void**)&obj) + || !enif_inspect_iolist_as_binary(env, argv[1], &data)) { + return enif_make_badarg(env); + } + enif_mutex_lock(obj->mtx); + if (!obj->alive) { + enif_mutex_unlock(obj->mtx); return enif_make_badarg(env); } + HMAC_Update(&obj->ctx, data.data, data.size); + enif_mutex_unlock(obj->mtx); - ctx_buf = enif_make_new_binary(env, sizeof(HMAC_CTX), &ret); - memcpy(ctx_buf, context.data, context.size); - HMAC_Update((HMAC_CTX *)ctx_buf, data.data, data.size); CONSUME_REDS(env,data); - - return ret; + return argv[0]; } static ERL_NIF_TERM hmac_final(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Context) or (Context, HashLen) */ - ErlNifBinary context; ERL_NIF_TERM ret; - HMAC_CTX ctx; + struct hmac_context* obj; unsigned char mac_buf[EVP_MAX_MD_SIZE]; unsigned char * mac_bin; unsigned int req_len = 0; unsigned int mac_len; - if (!enif_inspect_binary(env, argv[0], &context)) { - return enif_make_badarg(env); - } - if (argc == 2 && !enif_get_uint(env, argv[1], &req_len)) { + if (!enif_get_resource(env,argv[0],hmac_context_rtype, (void**)&obj) + || (argc == 2 && !enif_get_uint(env, argv[1], &req_len))) { return enif_make_badarg(env); } - if (context.size != sizeof(ctx)) { - return enif_make_badarg(env); + enif_mutex_lock(obj->mtx); + if (!obj->alive) { + enif_mutex_unlock(obj->mtx); + return enif_make_badarg(env); } - memcpy(&ctx, context.data, context.size); - HMAC_Final(&ctx, mac_buf, &mac_len); - HMAC_CTX_cleanup(&ctx); + HMAC_Final(&obj->ctx, mac_buf, &mac_len); + HMAC_CTX_cleanup(&obj->ctx); + obj->alive = 0; + enif_mutex_unlock(obj->mtx); if (argc == 2 && req_len < mac_len) { /* Only truncate to req_len bytes if asked. */ diff --git a/lib/crypto/c_src/crypto_callback.c b/lib/crypto/c_src/crypto_callback.c index 81106b4cc2..a08dcec463 100644 --- a/lib/crypto/c_src/crypto_callback.c +++ b/lib/crypto/c_src/crypto_callback.c @@ -1,7 +1,7 @@ /* * %CopyrightBegin% * - * Copyright Ericsson AB 2012. All Rights Reserved. + * Copyright Ericsson AB 2014. 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 @@ -17,6 +17,7 @@ * %CopyrightEnd% */ +#include <stdio.h> #include <string.h> #include <openssl/opensslconf.h> @@ -51,13 +52,28 @@ DLLEXPORT struct crypto_callbacks* get_crypto_callbacks(int nlocks); static ErlNifRWLock** lock_vec = NULL; /* Static locks used by openssl */ +static void nomem(size_t size, const char* op) +{ + fprintf(stderr, "Out of memory abort. Crypto failed to %s %zu bytes.\r\n", + op, size); + abort(); +} + static void* crypto_alloc(size_t size) { - return enif_alloc(size); + void *ret = enif_alloc(size); + + if (!ret && size) + nomem(size, "allocate"); + return ret; } static void* crypto_realloc(void* ptr, size_t size) { - return enif_realloc(ptr, size); + void* ret = enif_realloc(ptr, size); + + if (!ret && size) + nomem(size, "reallocate"); + return ret; } static void crypto_free(void* ptr) { diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index 40f829e704..c95827c371 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2013</year> + <year>1999</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -366,7 +366,11 @@ or to one of the functions <seealso marker="#hmac_final-1">hmac_final</seealso> and <seealso marker="#hmac_final_n-2">hmac_final_n</seealso> </p> - + <warning><p>Do not use a <c>Context</c> as argument in more than one + call to hmac_update or hmac_final. The semantics of reusing old contexts + in any way is undefined and could even crash the VM in earlier releases. + The reason for this limitation is a lack of support in the underlying + OpenSSL API.</p></warning> </desc> </func> diff --git a/lib/debugger/test/bs_construct_SUITE.erl b/lib/debugger/test/bs_construct_SUITE.erl index 4870c87d74..8a6798c6ad 100644 --- a/lib/debugger/test/bs_construct_SUITE.erl +++ b/lib/debugger/test/bs_construct_SUITE.erl @@ -647,19 +647,27 @@ make_sub_bin(Bin0) -> %% give the same result. dynamic(Config) when is_list(Config) -> - ?line dynamic_1(fun dynamic_big/5), - ?line dynamic_1(fun dynamic_little/5), + Ps = [spawn_monitor(fun() -> + dynamic_1(Fun) + end) || Fun <- [fun dynamic_big/5, + fun dynamic_little/5]], + [receive + {'DOWN',Ref,process,Pid,normal} -> + ok; + {'DOWN',Ref,process,Pid,Exit} -> + ?t:fail({Pid,Exit}) + end || {Pid,Ref} <- Ps], 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). + <<Lpad:64,_/binary>> = erlang:md5([0]), + <<Rpad:64,_/binary>> = erlang:md5([1]), + <<Int:64,_/binary>> = erlang:md5([2]), + 2145 = dynamic_2(0, {Int,Lpad,Rpad,Dynamic}, 0). -dynamic_2(129, _, Count) -> Count; +dynamic_2(64+1, _, Count) -> Count; dynamic_2(Bef, Data, Count0) -> - Count = dynamic_3(Bef, 128-Bef, Data, Count0), + Count = dynamic_3(Bef, 64-Bef, Data, Count0), dynamic_2(Bef+1, Data, Count). dynamic_3(_, -1, _, Count) -> Count; @@ -680,13 +688,13 @@ dynamic_big(Bef, N, Int, Lpad, Rpad) -> <<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)>>, + Bin = id(<<Lpad:Bef,NumBin/bitstring,Rpad:(64-Bef-N)>>), + Bin = <<Lpad:Bef,Int:N,Rpad:(64-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), + RpadMasked = Rpad band ((1 bsl (64-Bef-N)) - 1), + Rbits = (64-Bef-N), <<LpadMasked:Bef,MaskedInt:N,RpadMasked:Rbits>> = id(Bin), ok. @@ -696,13 +704,13 @@ dynamic_little(Bef, N, Int, Lpad, Rpad) -> <<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>>, + Bin = id(<<Lpad:Bef/little,NumBin/bitstring,Rpad:(64-Bef-N)/little>>), + Bin = <<Lpad:Bef/little,Int:N/little,Rpad:(64-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), + RpadMasked = Rpad band ((1 bsl (64-Bef-N)) - 1), + Rbits = (64-Bef-N), <<LpadMasked:Bef/little,MaskedInt:N/little,RpadMasked:Rbits/little>> = id(Bin), ok. diff --git a/lib/diameter/src/transport/diameter_sctp.erl b/lib/diameter/src/transport/diameter_sctp.erl index f5275e66b5..d0a01351f3 100644 --- a/lib/diameter/src/transport/diameter_sctp.erl +++ b/lib/diameter/src/transport/diameter_sctp.erl @@ -171,18 +171,33 @@ start_link(T) -> info({gen_sctp, Sock}) -> lists:flatmap(fun(K) -> info(K, Sock) end, - [{socket, sockname}, - {peer, peername}, + [{socket, socknames}, + {peer, peernames}, {statistics, getstat}]). info({K,F}, Sock) -> case inet:F(Sock) of {ok, V} -> - [{K,V}]; + [{K, map(F,V)}]; _ -> [] end. +%% inet:{sock,peer}names/1 returns [{Addr, Port}] but the port number +%% should be the same in each tuple. Map to a {[Addr], Port} tuple if +%% so. +map(K, [{_, Port} | _] = APs) + when K == socknames; + K == peernames -> + try [A || {A,P} <- APs, P == Port orelse throw(?MODULE)] of + As -> {As, Port} + catch + ?MODULE -> APs + end; + +map(_, V) -> + V. + %% --------------------------------------------------------------------------- %% # init/1 %% --------------------------------------------------------------------------- @@ -549,7 +564,7 @@ accept_peer(_, []) -> ok; accept_peer(Sock, Matches) -> - {RAddrs, _} = ok(inet:peername(Sock)), + RAddrs = [A || {A,_} <- ok(inet:peernames(Sock))], diameter_peer:match(RAddrs, Matches) orelse x({accept, RAddrs, Matches}), ok. diff --git a/lib/kernel/src/application_master.erl b/lib/kernel/src/application_master.erl index 68f78c6eb8..bc15b5a7de 100644 --- a/lib/kernel/src/application_master.erl +++ b/lib/kernel/src/application_master.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -27,7 +27,7 @@ -include("application_master.hrl"). --record(state, {child, appl_data, children = [], procs = 0, gleader}). +-record(state, {child, appl_data, children = [], procs = 0, gleader, req=[]}). %%----------------------------------------------------------------- %% Func: start_link/1 @@ -205,22 +205,25 @@ terminate_loop(Child, State) -> %%----------------------------------------------------------------- %% The Application Master is linked to *all* processes in the group -%% (application). +%% (application). %%----------------------------------------------------------------- handle_msg({get_child, Tag, From}, State) -> - From ! {Tag, get_child_i(State#state.child)}, - State; + get_child_i(State, Tag, From); handle_msg({stop, Tag, From}, State) -> catch terminate(normal, State), From ! {Tag, ok}, exit(normal); +handle_msg({child, Ref, GrandChild, Mod}, #state{req=Reqs0}=State) -> + {value, {_, Tag, From}, Reqs} = lists:keytake(Ref, 1, Reqs0), + From ! {Tag, {GrandChild, Mod}}, + State#state{req=Reqs}; handle_msg(_, State) -> State. - -terminate(Reason, State) -> - terminate_child(State#state.child, State), - kill_children(State#state.children), +terminate(Reason, State = #state{child=Child, children=Children, req=Reqs}) -> + _ = [From ! {Tag, error} || {_, Tag, From} <- Reqs], + terminate_child(Child, State), + kill_children(Children), exit(Reason). @@ -342,8 +345,8 @@ start_supervisor(Type, M, A) -> loop_it(Parent, Child, Mod, AppState) -> receive - {Parent, get_child} -> - Parent ! {self(), Child, Mod}, + {Parent, get_child, Ref} -> + Parent ! {child, Ref, Child, Mod}, loop_it(Parent, Child, Mod, AppState); {Parent, terminate} -> NewAppState = prep_stop(Mod, AppState), @@ -382,10 +385,15 @@ prep_stop(Mod, AppState) -> NewAppState end. -get_child_i(Child) -> - Child ! {self(), get_child}, - receive - {Child, GrandChild, Mod} -> {GrandChild, Mod} +get_child_i(#state{child=Child, req=Reqs}=State, Tag, From) -> + Ref = erlang:make_ref(), + case erlang:is_process_alive(Child) of + true -> + Child ! {self(), get_child, Ref}, + State#state{req=[{Ref, Tag, From}|Reqs]}; + false -> + From ! {Tag, error}, + State end. terminate_child_i(Child, State) -> diff --git a/lib/kernel/src/kernel.appup.src b/lib/kernel/src/kernel.appup.src index b946c2d1af..f8f4cc1ec2 100644 --- a/lib/kernel/src/kernel.appup.src +++ b/lib/kernel/src/kernel.appup.src @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. 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,12 +16,10 @@ %% %% %CopyrightEnd% {"%VSN%", - %% Up from - max two major revisions back + %% Up from - max one major revision back [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 - {<<"2\\.15(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R15 - %% Down to - max two major revisions back + {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16 + %% Down to - max one major revision back [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 - {<<"2\\.15(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R15 + {<<"2\\.16(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 }. diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl index ff62297f2d..ccb3760309 100644 --- a/lib/kernel/test/application_SUITE.erl +++ b/lib/kernel/test/application_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -36,7 +36,7 @@ -export([config_change/1, persistent_env/1, distr_changed_tc1/1, distr_changed_tc2/1, ensure_started/1, ensure_all_started/1, - shutdown_func/1, do_shutdown/1, shutdown_timeout/1]). + shutdown_func/1, do_shutdown/1, shutdown_timeout/1, shutdown_deadlock/1]). -define(TESTCASE, testcase_name). -define(testcase, ?config(?TESTCASE, Config)). @@ -54,6 +54,7 @@ all() -> script_start, nodedown_start, permit_false_start_local, permit_false_start_dist, get_key, get_env, ensure_all_started, {group, distr_changed}, config_change, shutdown_func, shutdown_timeout, + shutdown_deadlock, persistent_env]. groups() -> @@ -961,7 +962,7 @@ nodedown_start(Conf) when is_list(Conf) -> ensure_started(suite) -> []; ensure_started(doc) -> ["Test application:ensure_started/1."]; -ensure_started(Conf) -> +ensure_started(_Conf) -> {ok, Fd} = file:open("app1.app", [write]), w_app1(Fd), @@ -981,7 +982,7 @@ ensure_started(Conf) -> ensure_all_started(suite) -> []; ensure_all_started(doc) -> ["Test application:ensure_all_started/1-2."]; -ensure_all_started(Conf) -> +ensure_all_started(_Conf) -> {ok, Fd1} = file:open("app1.app", [write]), w_app1(Fd1), @@ -2096,7 +2097,31 @@ shutdown_timeout(Config) when is_list(Config) -> end, ok. +%%%----------------------------------------------------------------- +%%% Provokes a (previous) application shutdown deadlock +%%%----------------------------------------------------------------- +shutdown_deadlock(Config) when is_list(Config) -> + DataDir = ?config(data_dir,Config), + code:add_path(filename:join([DataDir,deadlock])), + %% ok = rpc:call(Cp1, application, start, [sasl]), + ok = application:start(deadlock), + Tester = self(), + application:set_env(deadlock, fail_stop, Tester), + spawn(fun() -> Tester ! {stop, application:stop(deadlock)} end), + receive + {deadlock, Server} -> + spawn(fun() -> + Master = application_controller:get_master(deadlock), + Child = application_master:get_child(Master), + Tester ! {child, Child} + end), + timer:sleep(100), + erlang:display({self(), "Sending Continue", Server}), + Server ! continue + end, + [_|_] = application:which_applications(), + ok. %%----------------------------------------------------------------- diff --git a/lib/kernel/test/application_SUITE_data/deadlock/deadlock.app b/lib/kernel/test/application_SUITE_data/deadlock/deadlock.app index 0c1001bed6..233c7a3f76 100644 --- a/lib/kernel/test/application_SUITE_data/deadlock/deadlock.app +++ b/lib/kernel/test/application_SUITE_data/deadlock/deadlock.app @@ -4,5 +4,5 @@ {applications, [kernel, stdlib, sasl]}, {modules, [deadlock]}, {mod, {deadlock, []}}, - {env, [{fail_start, false}]} + {env, [{fail_start, false}, {fail_stop, false}]} ]}. diff --git a/lib/kernel/test/application_SUITE_data/deadlock/deadlock.erl b/lib/kernel/test/application_SUITE_data/deadlock/deadlock.erl index 5f68bf9078..3ef6105371 100644 --- a/lib/kernel/test/application_SUITE_data/deadlock/deadlock.erl +++ b/lib/kernel/test/application_SUITE_data/deadlock/deadlock.erl @@ -21,7 +21,7 @@ init([sup]) -> {ok, {{one_for_one, 5, 10}, [ { sasl_syslog_dm, {?MODULE, start_link, []}, - permanent, brutal_kill, worker, + permanent, 25000, worker, [deadlock] } ]}}; @@ -32,6 +32,8 @@ init([sup]) -> init([child]) -> case application:get_env(deadlock, fail_start) of {ok, false} -> + process_flag(trap_exit, true), + io:format("~p: Traps exit~n",[?MODULE]), %% we must not fail on the first init, otherwise supervisor %% terminates immediately {ok, []}; @@ -50,6 +52,14 @@ handle_info(_Msg, State) -> {noreply, State}. terminate(_Reason, _State) -> + case application:get_env(deadlock, fail_stop) of + {ok, false} -> ok; + {ok, Tester} -> + Tester ! {deadlock, self()}, + io:format("~p: Waiting in terminate (~p)~n",[?MODULE,Tester]), + receive continue -> ok end + end, + io:format("~p: terminates~n", [?MODULE]), ok. code_change(_OldVsn, State, _Extra) -> diff --git a/lib/kernel/test/kernel_SUITE.erl b/lib/kernel/test/kernel_SUITE.erl index 75f51eb076..2d8123c9c4 100644 --- a/lib/kernel/test/kernel_SUITE.erl +++ b/lib/kernel/test/kernel_SUITE.erl @@ -78,17 +78,18 @@ app_test(Config) when is_list(Config) -> ok. -%% Test that appup allows upgrade from/downgrade to a maximum of two -%% major releases back. +%% Test that appup allows upgrade from/downgrade to a maximum of one +%% major release back. appup_test(_Config) -> - do_appup_tests(create_test_vsns()). + appup_tests(kernel,create_test_vsns(kernel)). -do_appup_tests({[],[]}) -> +appup_tests(_App,{[],[]}) -> {skip,"no previous releases available"}; -do_appup_tests({OkVsns,NokVsns}) -> - application:load(kernel), - {_,_,Vsn} = lists:keyfind(kernel,1,application:loaded_applications()), - AppupFile = filename:join([code:lib_dir(kernel),ebin,"kernel.appup"]), +appup_tests(App,{OkVsns,NokVsns}) -> + application:load(App), + {_,_,Vsn} = lists:keyfind(App,1,application:loaded_applications()), + AppupFileName = atom_to_list(App) ++ ".appup", + AppupFile = filename:join([code:lib_dir(App),ebin,AppupFileName]), {ok,[{Vsn,UpFrom,DownTo}=AppupScript]} = file:consult(AppupFile), ct:log("~p~n",[AppupScript]), ct:log("Testing ok versions: ~p~n",[OkVsns]), @@ -99,13 +100,12 @@ do_appup_tests({OkVsns,NokVsns}) -> check_appup(NokVsns,DownTo,error), ok. -create_test_vsns() -> +create_test_vsns(App) -> This = erlang:system_info(otp_release), FirstMajor = previous_major(This), SecondMajor = previous_major(FirstMajor), - ThirdMajor = previous_major(SecondMajor), - Ok = kernel_vsn([FirstMajor,SecondMajor]), - Nok0 = kernel_vsn([ThirdMajor]), + Ok = app_vsn(App,[FirstMajor]), + Nok0 = app_vsn(App,[SecondMajor]), Nok = case Ok of [Ok1|_] -> [Ok1 ++ ",1" | Nok0]; % illegal @@ -121,18 +121,36 @@ previous_major("r"++Rel) -> previous_major(Rel) -> integer_to_list(list_to_integer(Rel)-1). -kernel_vsn([R|Rs]) -> - case test_server:is_release_available(R) of - true -> - {ok,N} = test_server:start_node(prevrel,peer,[{erl,[{release,R}]}]), - As = rpc:call(N,application,which_applications,[]), - {_,_,KV} = lists:keyfind(kernel,1,As), - test_server:stop_node(N), - [KV|kernel_vsn(Rs)]; +app_vsn(App,[R|Rs]) -> + OldRel = + case test_server:is_release_available(R) of + true -> + {release,R}; + false -> + case ct:get_config({otp_releases,list_to_atom(R)}) of + undefined -> + false; + Prog0 -> + case os:find_executable(Prog0) of + false -> + false; + Prog -> + {prog,Prog} + end + end + end, + case OldRel of false -> - kernel_vsn(Rs) + app_vsn(App,Rs); + _ -> + {ok,N} = test_server:start_node(prevrel,peer,[{erl,[OldRel]}]), + _ = rpc:call(N,application,load,[App]), + As = rpc:call(N,application,loaded_applications,[]), + {_,_,V} = lists:keyfind(App,1,As), + test_server:stop_node(N), + [V|app_vsn(App,Rs)] end; -kernel_vsn([]) -> +app_vsn(_App,[]) -> []. check_appup([Vsn|Vsns],Instrs,Expected) -> diff --git a/lib/runtime_tools/src/observer_backend.erl b/lib/runtime_tools/src/observer_backend.erl index 68ef04f20c..fea0854042 100644 --- a/lib/runtime_tools/src/observer_backend.erl +++ b/lib/runtime_tools/src/observer_backend.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2013. All Rights Reserved. +%% Copyright Ericsson AB 2002-2014. 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 @@ -227,7 +227,9 @@ fetch_stats(Parent, Time) -> fetch_stats_loop(Parent, Time) -> erlang:system_flag(scheduler_wall_time, true), receive - _Msg -> erlang:system_flag(scheduler_wall_time, false) + _Msg -> + %% erlang:system_flag(scheduler_wall_time, false) + ok after Time -> _M = Parent ! {stats, 1, erlang:statistics(scheduler_wall_time), @@ -244,17 +246,6 @@ etop_collect(Collector) -> %% utilization in etop). Next time the flag will be true and then %% there will be a measurement. SchedulerWallTime = erlang:statistics(scheduler_wall_time), - - %% Turn off the flag while collecting data per process etc. - case erlang:system_flag(scheduler_wall_time,false) of - false -> - %% First time and the flag was false - start a monitoring - %% process to set the flag back to false when etop is stopped. - spawn(fun() -> flag_holder_proc(Collector) end); - _ -> - ok - end, - ProcInfo = etop_collect(processes(), []), Collector ! {self(),#etop_info{now = now(), @@ -264,13 +255,22 @@ etop_collect(Collector) -> memi = etop_memi(), procinfo = ProcInfo }}, + + case SchedulerWallTime of + undefined -> + spawn(fun() -> flag_holder_proc(Collector) end); + _ -> + ok + end, + erlang:system_flag(scheduler_wall_time,true). flag_holder_proc(Collector) -> Ref = erlang:monitor(process,Collector), receive {'DOWN',Ref,_,_,_} -> - erlang:system_flag(scheduler_wall_time,false) + %% erlang:system_flag(scheduler_wall_time,false) + ok end. etop_memi() -> diff --git a/lib/sasl/src/sasl.appup.src b/lib/sasl/src/sasl.appup.src index 0c4d80a74f..e789853eea 100644 --- a/lib/sasl/src/sasl.appup.src +++ b/lib/sasl/src/sasl.appup.src @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. 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,12 +16,10 @@ %% %% %CopyrightEnd% {"%VSN%", - %% Up from - max two major revisions back + %% Up from - max one major revision back [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 - {<<"2\\.2(\\.[0-9]+)*">>,[restart_new_emulator]}], %% R15 - %% Down to - max two major revisions back + {<<"2\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}], %% R16 + %% Down to - max one major revision back [{<<"2\\.4(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"2\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 - {<<"2\\.2(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R15 + {<<"2\\.3(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 }. diff --git a/lib/sasl/test/sasl_SUITE.erl b/lib/sasl/test/sasl_SUITE.erl index e799230338..ad63a31cbd 100644 --- a/lib/sasl/test/sasl_SUITE.erl +++ b/lib/sasl/test/sasl_SUITE.erl @@ -22,7 +22,6 @@ %% Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). --define(application, sasl). %% Test server specific exports -export([all/0,groups/0,init_per_group/2,end_per_group/2]). @@ -58,17 +57,18 @@ app_test(Config) when is_list(Config) -> ?t:app_test(sasl, allow), ok. -%% Test that appup allows upgrade from/downgrade to a maximum of two -%% major releases back. +%% Test that appup allows upgrade from/downgrade to a maximum of one +%% major release back. appup_test(_Config) -> - do_appup_tests(create_test_vsns()). + appup_tests(sasl,create_test_vsns(sasl)). -do_appup_tests({[],[]}) -> +appup_tests(_App,{[],[]}) -> {skip,"no previous releases available"}; -do_appup_tests({OkVsns,NokVsns}) -> - application:load(sasl), - {_,_,Vsn} = lists:keyfind(sasl,1,application:loaded_applications()), - AppupFile = filename:join([code:lib_dir(sasl),ebin,"sasl.appup"]), +appup_tests(App,{OkVsns,NokVsns}) -> + application:load(App), + {_,_,Vsn} = lists:keyfind(App,1,application:loaded_applications()), + AppupFileName = atom_to_list(App) ++ ".appup", + AppupFile = filename:join([code:lib_dir(App),ebin,AppupFileName]), {ok,[{Vsn,UpFrom,DownTo}=AppupScript]} = file:consult(AppupFile), ct:log("~p~n",[AppupScript]), ct:log("Testing ok versions: ~p~n",[OkVsns]), @@ -79,13 +79,12 @@ do_appup_tests({OkVsns,NokVsns}) -> check_appup(NokVsns,DownTo,error), ok. -create_test_vsns() -> +create_test_vsns(App) -> This = erlang:system_info(otp_release), FirstMajor = previous_major(This), SecondMajor = previous_major(FirstMajor), - ThirdMajor = previous_major(SecondMajor), - Ok = sasl_vsn([FirstMajor,SecondMajor]), - Nok0 = sasl_vsn([ThirdMajor]), + Ok = app_vsn(App,[FirstMajor]), + Nok0 = app_vsn(App,[SecondMajor]), Nok = case Ok of [Ok1|_] -> [Ok1 ++ ",1" | Nok0]; % illegal @@ -101,19 +100,36 @@ previous_major("r"++Rel) -> previous_major(Rel) -> integer_to_list(list_to_integer(Rel)-1). -sasl_vsn([R|Rs]) -> - case test_server:is_release_available(R) of - true -> - {ok,N} = test_server:start_node(prevrel,peer,[{erl,[{release,R}]}]), - _ = rpc:call(N,application,load,[sasl]), +app_vsn(App,[R|Rs]) -> + OldRel = + case test_server:is_release_available(R) of + true -> + {release,R}; + false -> + case ct:get_config({otp_releases,list_to_atom(R)}) of + undefined -> + false; + Prog0 -> + case os:find_executable(Prog0) of + false -> + false; + Prog -> + {prog,Prog} + end + end + end, + case OldRel of + false -> + app_vsn(App,Rs); + _ -> + {ok,N} = test_server:start_node(prevrel,peer,[{erl,[OldRel]}]), + _ = rpc:call(N,application,load,[App]), As = rpc:call(N,application,loaded_applications,[]), - {_,_,V} = lists:keyfind(sasl,1,As), + {_,_,V} = lists:keyfind(App,1,As), test_server:stop_node(N), - [V|sasl_vsn(Rs)]; - false -> - sasl_vsn(Rs) + [V|app_vsn(App,Rs)] end; -sasl_vsn([]) -> +app_vsn(_App,[]) -> []. check_appup([Vsn|Vsns],Instrs,Expected) -> diff --git a/lib/sasl/test/test_lib.hrl b/lib/sasl/test/test_lib.hrl index 37aa44c198..c8a4e92f24 100644 --- a/lib/sasl/test/test_lib.hrl +++ b/lib/sasl/test/test_lib.hrl @@ -1,3 +1,3 @@ -define(ertsvsn,"4.4"). --define(kernelvsn,"2.15.3"). --define(stdlibvsn,"1.18.3"). +-define(kernelvsn,"2.16.4"). +-define(stdlibvsn,"1.19.4"). diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 21cf8e4149..3df24bf688 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2013</year> + <year>1996</year><year>2014</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -171,6 +171,10 @@ <p>Returns a list of all tables at the node. Named tables are given by their names, unnamed tables are given by their table identifiers.</p> + <p>There is no guarantee of consistency in the returned list. Tables created + or deleted by other processes "during" the ets:all() call may or may + not be included in the list. Only tables created/deleted <em>before</em> + ets:all() is called are guaranteed to be included/excluded.</p> </desc> </func> <func> diff --git a/lib/stdlib/src/edlin_expand.erl b/lib/stdlib/src/edlin_expand.erl index 0033010dce..a2b4663219 100644 --- a/lib/stdlib/src/edlin_expand.erl +++ b/lib/stdlib/src/edlin_expand.erl @@ -73,7 +73,7 @@ to_atom(Str) -> error end. -match(Prefix, Alts, Extra) -> +match(Prefix, Alts, Extra0) -> Len = length(Prefix), Matches = lists:sort( [{S, A} || {H, A} <- Alts, @@ -89,13 +89,11 @@ match(Prefix, Alts, Extra) -> {yes, Remain, []} end; {complete, Str} -> - {_, Arity} = lists:keyfind(Str, 1, Matches), - case {Arity, Extra} of - {0, "("} -> - {yes, nthtail(Len, Str) ++ "()", []}; - _ -> - {yes, nthtail(Len, Str) ++ Extra, []} - end; + Extra = case {Extra0,Matches} of + {"(",[{Str,0}]} -> "()"; + {_,_} -> Extra0 + end, + {yes, nthtail(Len, Str) ++ Extra, []}; no -> {no, [], []} end. diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index 749a9a4201..22eefb2514 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -1,7 +1,7 @@ %% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2013. All Rights Reserved. +%% Copyright Ericsson AB 1999-2014. 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,12 +16,10 @@ %% %% %CopyrightEnd% {"%VSN%", - %% Up from - max two major revisions back + %% Up from - max one major revision back [{<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 - {<<"1\\.18(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R15 - %% Down to - max two major revisions back + {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}],%% R16 + %% Down to - max one major revision back [{<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R17 - {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}, %% R16 - {<<"1\\.18(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R15 + {<<"1\\.19(\\.[0-9]+)*">>,[restart_new_emulator]}] %% R16 }. diff --git a/lib/stdlib/test/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl index 2c1c5acf5a..43c980e994 100644 --- a/lib/stdlib/test/edlin_expand_SUITE.erl +++ b/lib/stdlib/test/edlin_expand_SUITE.erl @@ -26,11 +26,11 @@ -include_lib("test_server/include/test_server.hrl"). -% Default timetrap timeout (set in init_per_testcase). +%% Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). init_per_testcase(_Case, Config) -> - ?line Dog = ?t:timetrap(?default_timeout), + Dog = ?t:timetrap(?default_timeout), [{watchdog, Dog} | Config]. end_per_testcase(_Case, Config) -> Dog = ?config(watchdog, Config), @@ -67,23 +67,21 @@ normal(doc) -> normal(suite) -> []; normal(Config) when is_list(Config) -> - ?line {module,expand_test} = c:l(expand_test), - % These tests might fail if another module with the prefix "expand_" happens - % to also be loaded. - ?line {yes, "test:", []} = edlin_expand:expand(lists:reverse("expand_")), - ?line {no, [], []} = edlin_expand:expand(lists:reverse("expandXX_")), - ?line {no,[], - [{"a_fun_name",1}, - {"a_less_fun_name",1}, - {"b_comes_after_a",1}, - {"expand0arity_entirely",0}, - {"module_info",0}, - {"module_info",1}]} = edlin_expand:expand(lists:reverse("expand_test:")), - ?line {yes,[],[{"a_fun_name",1}, - {"a_less_fun_name",1}]} = edlin_expand:expand( - lists:reverse("expand_test:a_")), - ?line {yes,"arity_entirely()",[]} = edlin_expand:expand( - lists:reverse("expand_test:expand0")), + {module,expand_test} = c:l(expand_test), + %% These tests might fail if another module with the prefix + %% "expand_" happens to also be loaded. + {yes, "test:", []} = do_expand("expand_"), + {no, [], []} = do_expand("expandXX_"), + {no,[], + [{"a_fun_name",1}, + {"a_less_fun_name",1}, + {"b_comes_after_a",1}, + {"expand0arity_entirely",0}, + {"module_info",0}, + {"module_info",1}]} = do_expand("expand_test:"), + {yes,[],[{"a_fun_name",1}, + {"a_less_fun_name",1}]} = do_expand("expand_test:a_"), + {yes,"arity_entirely()",[]} = do_expand("expand_test:expand0"), ok. quoted_fun(doc) -> @@ -91,38 +89,35 @@ quoted_fun(doc) -> quoted_fun(suite) -> []; quoted_fun(Config) when is_list(Config) -> - ?line {module,expand_test} = c:l(expand_test), - ?line {module,expand_test1} = c:l(expand_test1), + {module,expand_test} = c:l(expand_test), + {module,expand_test1} = c:l(expand_test1), %% should be no colon after test this time - ?line {yes, "test", []} = edlin_expand:expand(lists:reverse("expand_")), - ?line {no, [], []} = edlin_expand:expand(lists:reverse("expandXX_")), - ?line {no,[],[{"'#weird-fun-name'",1}, - {"'Quoted_fun_name'",0}, - {"'Quoted_fun_too'",0}, - {"a_fun_name",1}, - {"a_less_fun_name",1}, - {"b_comes_after_a",1}, - {"module_info",0}, - {"module_info",1}]} = edlin_expand:expand( - lists:reverse("expand_test1:")), - ?line {yes,"_",[]} = edlin_expand:expand( - lists:reverse("expand_test1:a")), - ?line {yes,[],[{"a_fun_name",1}, - {"a_less_fun_name",1}]} = edlin_expand:expand( - lists:reverse("expand_test1:a_")), - ?line {yes,[], - [{"'#weird-fun-name'",1}, + {yes, "test", []} = do_expand("expand_"), + {no, [], []} = do_expand("expandXX_"), + {no,[],[{"'#weird-fun-name'",1}, {"'Quoted_fun_name'",0}, - {"'Quoted_fun_too'",0}]} = edlin_expand:expand( - lists:reverse("expand_test1:'")), - ?line {yes,"uoted_fun_",[]} = edlin_expand:expand( - lists:reverse("expand_test1:'Q")), - ?line {yes,[], - [{"'Quoted_fun_name'",0}, - {"'Quoted_fun_too'",0}]} = edlin_expand:expand( - lists:reverse("expand_test1:'Quoted_fun_")), - ?line {yes,"weird-fun-name'(",[]} = edlin_expand:expand( - lists:reverse("expand_test1:'#")), + {"'Quoted_fun_too'",0}, + {"a_fun_name",1}, + {"a_less_fun_name",1}, + {"b_comes_after_a",1}, + {"module_info",0}, + {"module_info",1}]} = do_expand("expand_test1:"), + {yes,"_",[]} = do_expand("expand_test1:a"), + {yes,[],[{"a_fun_name",1}, + {"a_less_fun_name",1}]} = do_expand("expand_test1:a_"), + {yes,[], + [{"'#weird-fun-name'",1}, + {"'Quoted_fun_name'",0}, + {"'Quoted_fun_too'",0}]} = do_expand("expand_test1:'"), + {yes,"uoted_fun_",[]} = do_expand("expand_test1:'Q"), + {yes,[], + [{"'Quoted_fun_name'",0}, + {"'Quoted_fun_too'",0}]} = do_expand("expand_test1:'Quoted_fun_"), + {yes,"weird-fun-name'(",[]} = do_expand("expand_test1:'#"), + + %% Since there is a module_info/1 as well as a module_info/0 + %% there should not be a closing parenthesis added. + {yes,"(",[]} = do_expand("expand_test:module_info"), ok. quoted_module(doc) -> @@ -130,51 +125,46 @@ quoted_module(doc) -> quoted_module(suite) -> []; quoted_module(Config) when is_list(Config) -> - ?line {module,'ExpandTestCaps'} = c:l('ExpandTestCaps'), - ?line {yes, "Caps':", []} = edlin_expand:expand(lists:reverse("'ExpandTest")), - ?line {no,[], - [{"a_fun_name",1}, - {"a_less_fun_name",1}, - {"b_comes_after_a",1}, - {"module_info",0}, - {"module_info",1}]} = edlin_expand:expand(lists:reverse("'ExpandTestCaps':")), - ?line {yes,[],[{"a_fun_name",1}, - {"a_less_fun_name",1}]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps':a_")), + {module,'ExpandTestCaps'} = c:l('ExpandTestCaps'), + {yes, "Caps':", []} = do_expand("'ExpandTest"), + {no,[], + [{"a_fun_name",1}, + {"a_less_fun_name",1}, + {"b_comes_after_a",1}, + {"module_info",0}, + {"module_info",1}]} = do_expand("'ExpandTestCaps':"), + {yes,[],[{"a_fun_name",1}, + {"a_less_fun_name",1}]} = do_expand("'ExpandTestCaps':a_"), ok. quoted_both(suite) -> []; quoted_both(Config) when is_list(Config) -> - ?line {module,'ExpandTestCaps'} = c:l('ExpandTestCaps'), - ?line {module,'ExpandTestCaps1'} = c:l('ExpandTestCaps1'), + {module,'ExpandTestCaps'} = c:l('ExpandTestCaps'), + {module,'ExpandTestCaps1'} = c:l('ExpandTestCaps1'), %% should be no colon (or quote) after test this time - ?line {yes, "Caps", []} = edlin_expand:expand(lists:reverse("'ExpandTest")), - ?line {no,[],[{"'#weird-fun-name'",0}, - {"'Quoted_fun_name'",0}, - {"'Quoted_fun_too'",0}, - {"a_fun_name",1}, - {"a_less_fun_name",1}, - {"b_comes_after_a",1}, - {"module_info",0}, - {"module_info",1}]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':")), - ?line {yes,"_",[]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':a")), - ?line {yes,[],[{"a_fun_name",1}, - {"a_less_fun_name",1}]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':a_")), - ?line {yes,[], - [{"'#weird-fun-name'",0}, + {yes, "Caps", []} = do_expand("'ExpandTest"), + {no,[],[{"'#weird-fun-name'",0}, {"'Quoted_fun_name'",0}, - {"'Quoted_fun_too'",0}]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':'")), - ?line {yes,"uoted_fun_",[]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':'Q")), - ?line {yes,[], - [{"'Quoted_fun_name'",0}, - {"'Quoted_fun_too'",0}]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':'Quoted_fun_")), - ?line {yes,"weird-fun-name'()",[]} = edlin_expand:expand( - lists:reverse("'ExpandTestCaps1':'#")), + {"'Quoted_fun_too'",0}, + {"a_fun_name",1}, + {"a_less_fun_name",1}, + {"b_comes_after_a",1}, + {"module_info",0}, + {"module_info",1}]} = do_expand("'ExpandTestCaps1':"), + {yes,"_",[]} = do_expand("'ExpandTestCaps1':a"), + {yes,[],[{"a_fun_name",1}, + {"a_less_fun_name",1}]} = do_expand("'ExpandTestCaps1':a_"), + {yes,[], + [{"'#weird-fun-name'",0}, + {"'Quoted_fun_name'",0}, + {"'Quoted_fun_too'",0}]} = do_expand("'ExpandTestCaps1':'"), + {yes,"uoted_fun_",[]} = do_expand("'ExpandTestCaps1':'Q"), + {yes,[], + [{"'Quoted_fun_name'",0}, + {"'Quoted_fun_too'",0}]} = do_expand("'ExpandTestCaps1':'Quoted_fun_"), + {yes,"weird-fun-name'()",[]} = do_expand("'ExpandTestCaps1':'#"), ok. + +do_expand(String) -> + edlin_expand:expand(lists:reverse(String)). diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 82c3e7ecaf..8dc8b2c291 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2014. 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 @@ -75,6 +75,7 @@ -export([otp_9932/1]). -export([otp_9423/1]). -export([otp_10182/1]). +-export([ets_all/1]). -export([memory_check_summary/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -151,6 +152,7 @@ all() -> otp_10182, otp_9932, otp_9423, + ets_all, memory_check_summary]. % MUST BE LAST @@ -5565,7 +5567,19 @@ otp_10182(Config) when is_list(Config) -> ets:delete(Db), In = Out. - +%% Test that ets:all include/exclude tables that we know are created/deleted +ets_all(Config) when is_list(Config) -> + Pids = [spawn_link(fun() -> ets_all_run() end) || _ <- [1,2]], + receive after 3*1000 -> ok end, + [begin unlink(P), exit(P,kill) end || P <- Pids], + ok. + +ets_all_run() -> + Table = ets:new(undefined, []), + true = lists:member(Table, ets:all()), + ets:delete(Table), + false = lists:member(Table, ets:all()), + ets_all_run(). % diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl index 8fff5e2e05..b0d6913636 100644 --- a/lib/stdlib/test/stdlib_SUITE.erl +++ b/lib/stdlib/test/stdlib_SUITE.erl @@ -25,7 +25,6 @@ % Default timetrap timeout (set in init_per_testcase). -define(default_timeout, ?t:minutes(1)). --define(application, stdlib). % Test server specific exports -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, @@ -78,17 +77,18 @@ app_test(Config) when is_list(Config) -> ?t:app_test(stdlib), ok. -%% Test that appup allows upgrade from/downgrade to a maximum of two -%% major releases back. +%% Test that appup allows upgrade from/downgrade to a maximum of one +%% major release back. appup_test(_Config) -> - do_appup_tests(create_test_vsns()). + appup_tests(stdlib,create_test_vsns(stdlib)). -do_appup_tests({[],[]}) -> +appup_tests(_App,{[],[]}) -> {skip,"no previous releases available"}; -do_appup_tests({OkVsns,NokVsns}) -> - application:load(stdlib), - {_,_,Vsn} = lists:keyfind(stdlib,1,application:loaded_applications()), - AppupFile = filename:join([code:lib_dir(stdlib),ebin,"stdlib.appup"]), +appup_tests(App,{OkVsns,NokVsns}) -> + application:load(App), + {_,_,Vsn} = lists:keyfind(App,1,application:loaded_applications()), + AppupFileName = atom_to_list(App) ++ ".appup", + AppupFile = filename:join([code:lib_dir(App),ebin,AppupFileName]), {ok,[{Vsn,UpFrom,DownTo}=AppupScript]} = file:consult(AppupFile), ct:log("~p~n",[AppupScript]), ct:log("Testing ok versions: ~p~n",[OkVsns]), @@ -99,13 +99,12 @@ do_appup_tests({OkVsns,NokVsns}) -> check_appup(NokVsns,DownTo,error), ok. -create_test_vsns() -> +create_test_vsns(App) -> This = erlang:system_info(otp_release), FirstMajor = previous_major(This), SecondMajor = previous_major(FirstMajor), - ThirdMajor = previous_major(SecondMajor), - Ok = stdlib_vsn([FirstMajor,SecondMajor]), - Nok0 = stdlib_vsn([ThirdMajor]), + Ok = app_vsn(App,[FirstMajor]), + Nok0 = app_vsn(App,[SecondMajor]), Nok = case Ok of [Ok1|_] -> [Ok1 ++ ",1" | Nok0]; % illegal @@ -121,18 +120,36 @@ previous_major("r"++Rel) -> previous_major(Rel) -> integer_to_list(list_to_integer(Rel)-1). -stdlib_vsn([R|Rs]) -> - case test_server:is_release_available(R) of - true -> - {ok,N} = test_server:start_node(prevrel,peer,[{erl,[{release,R}]}]), - As = rpc:call(N,application,which_applications,[]), - {_,_,KV} = lists:keyfind(stdlib,1,As), - test_server:stop_node(N), - [KV|stdlib_vsn(Rs)]; +app_vsn(App,[R|Rs]) -> + OldRel = + case test_server:is_release_available(R) of + true -> + {release,R}; + false -> + case ct:get_config({otp_releases,list_to_atom(R)}) of + undefined -> + false; + Prog0 -> + case os:find_executable(Prog0) of + false -> + false; + Prog -> + {prog,Prog} + end + end + end, + case OldRel of false -> - stdlib_vsn(Rs) + app_vsn(App,Rs); + _ -> + {ok,N} = test_server:start_node(prevrel,peer,[{erl,[OldRel]}]), + _ = rpc:call(N,application,load,[App]), + As = rpc:call(N,application,loaded_applications,[]), + {_,_,V} = lists:keyfind(App,1,As), + test_server:stop_node(N), + [V|app_vsn(App,Rs)] end; -stdlib_vsn([]) -> +app_vsn(_App,[]) -> []. check_appup([Vsn|Vsns],Instrs,Expected) -> diff --git a/lib/test_server/src/configure.in b/lib/test_server/src/configure.in index 067663feb4..cd723bcd4d 100644 --- a/lib/test_server/src/configure.in +++ b/lib/test_server/src/configure.in @@ -2,7 +2,7 @@ dnl Process this file with autoconf to produce a configure script for Erlang. dnl dnl %CopyrightBegin% dnl -dnl Copyright Ericsson AB 1997-2013. All Rights Reserved. +dnl Copyright Ericsson AB 1997-2014. All Rights Reserved. dnl dnl The contents of this file are subject to the Erlang Public License, dnl Version 1.1, (the "License"); you may not use this file except in @@ -170,7 +170,30 @@ case $system in fi SHLIB_EXTRACT_ALL="" ;; - *-netbsd*|*-freebsd*|*-openbsd*|*-dragonfly*) + *-openbsd*) + # Not available on all versions: check for include file. + AC_CHECK_HEADER(dlfcn.h, [ + SHLIB_CFLAGS="-fpic" + SHLIB_LD="${CC}" + SHLIB_LDFLAGS="$LDFLAGS -shared" + SHLIB_SUFFIX=".so" + if test X${enable_m64_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 64-bit dynamic drivers) + fi + if test X${enable_m32_build} = Xyes; then + AC_MSG_ERROR(don't know how to link 32-bit dynamic drivers) + fi + ], [ + # No dynamic loading. + SHLIB_CFLAGS="" + SHLIB_LD="ld" + SHLIB_LDFLAGS="" + SHLIB_SUFFIX="" + AC_MSG_ERROR(don't know how to compile and link dynamic drivers) + ]) + SHLIB_EXTRACT_ALL="" + ;; + *-netbsd*|*-freebsd*|*-dragonfly*) # Not available on all versions: check for include file. AC_CHECK_HEADER(dlfcn.h, [ SHLIB_CFLAGS="-fpic" diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 3a868f1300..f007f780eb 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -664,6 +664,7 @@ resulting regexp is surrounded by \\_< and \\_>." "is_function" "is_integer" "is_list" + "is_map" "is_number" "is_pid" "is_port" @@ -715,7 +716,8 @@ resulting regexp is surrounded by \\_< and \\_>." "pos_integer" "string" "term" - "timeout") + "timeout" + "map") "Erlang type specs types")) (eval-and-compile @@ -772,6 +774,7 @@ resulting regexp is surrounded by \\_< and \\_>." "is_function" "is_integer" "is_list" + "is_map" "is_number" "is_pid" "is_port" @@ -791,6 +794,7 @@ resulting regexp is surrounded by \\_< and \\_>." "list_to_tuple" "load_module" "make_ref" + "map_size" "max" "min" "module_loaded" diff --git a/lib/tools/test/eprof_SUITE.erl b/lib/tools/test/eprof_SUITE.erl index 26685a6a84..1227d5b841 100644 --- a/lib/tools/test/eprof_SUITE.erl +++ b/lib/tools/test/eprof_SUITE.erl @@ -127,6 +127,14 @@ basic(Config) when is_list(Config) -> ok. basic_option(Config) when is_list(Config) -> + %% Eprof is not supported on native-compile code. + case lists:module_info(native_addresses) of + [] -> basic_option_1(Config); + [_|_] -> {skip,"lists is native-compiled"} + end. + +basic_option_1(Config) -> + %% load eprof_test and change directory {ok, OldCurDir} = file:get_cwd(), |