diff options
85 files changed, 2715 insertions, 1380 deletions
diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index 509aa2a84f..8f02d509a9 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -40,6 +40,7 @@ #include "erl_binary.h" #include "erl_thr_progress.h" #include "erl_nfunc_sched.h" +#include "beam_catches.h" #ifdef ARCH_64 # define HEXF "%016bpX" @@ -55,6 +56,7 @@ static int print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) static void print_bif_name(fmtfn_t to, void* to_arg, BifFunction bif); static BeamInstr* f_to_addr(BeamInstr* base, int op, BeamInstr* ap); static BeamInstr* f_to_addr_packed(BeamInstr* base, int op, Sint32* ap); +static void print_byte_string(fmtfn_t to, void *to_arg, byte* str, Uint bytes); BIF_RETTYPE erts_debug_same_2(BIF_ALIST_2) @@ -396,6 +398,7 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) BeamInstr args[8]; /* Arguments for this instruction. */ BeamInstr* ap; /* Pointer to arguments. */ BeamInstr* unpacked; /* Unpacked arguments */ + BeamInstr* first_arg; /* First argument */ start_prog = opc[op].pack; @@ -480,6 +483,8 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) ap = args; } + first_arg = ap; + /* * Print the name and all operands of the instructions. */ @@ -570,24 +575,60 @@ print_op(fmtfn_t to, void *to_arg, int op, int size, BeamInstr* addr) } break; } + case op_i_make_fun_Wt: + if (*sign == 'W') { + ErlFunEntry* fe = (ErlFunEntry *) *ap; + ErtsCodeMFA* cmfa = find_function_from_pc(fe->address); + erts_print(to, to_arg, "%T:%T/%bpu", cmfa->module, + cmfa->function, cmfa->arity); + } else { + erts_print(to, to_arg, "%d", *ap); + } + break; + case op_i_bs_match_string_xfWW: + if (ap - first_arg < 3) { + erts_print(to, to_arg, "%d", *ap); + } else { + Uint bits = ap[-1]; + Uint bytes = (bits+7)/8; + byte* str = (byte *) *ap; + print_byte_string(to, to_arg, str, bytes); + } + break; + case op_bs_put_string_WW: + if (ap - first_arg == 0) { + erts_print(to, to_arg, "%d", *ap); + } else { + Uint bytes = ap[-1]; + byte* str = (byte *) ap[0]; + print_byte_string(to, to_arg, str, bytes); + } + break; default: erts_print(to, to_arg, "%d", *ap); } ap++; break; case 'f': /* Destination label */ - { - BeamInstr* target = f_to_addr(addr, op, ap); - ErtsCodeMFA* cmfa = find_function_from_pc(target); - if (!cmfa || erts_codemfa_to_code(cmfa) != target) { - erts_print(to, to_arg, "f(" HEXF ")", target); - } else { - erts_print(to, to_arg, "%T:%T/%bpu", cmfa->module, - cmfa->function, cmfa->arity); - } - ap++; - } - break; + switch (op) { + case op_catch_yf: + erts_print(to, to_arg, "f(" HEXF ")", catch_pc((BeamInstr)*ap)); + break; + default: + { + BeamInstr* target = f_to_addr(addr, op, ap); + ErtsCodeMFA* cmfa = find_function_from_pc(target); + if (!cmfa || erts_codemfa_to_code(cmfa) != target) { + erts_print(to, to_arg, "f(" HEXF ")", target); + } else { + erts_print(to, to_arg, "%T:%T/%bpu", cmfa->module, + cmfa->function, cmfa->arity); + } + ap++; + } + break; + } + break; case 'p': /* Pointer (to label) */ { BeamInstr* target = f_to_addr(addr, op, ap); @@ -848,6 +889,14 @@ static BeamInstr* f_to_addr_packed(BeamInstr* base, int op, Sint32* ap) return base - 1 + opc[op].adjust + *ap; } +static void print_byte_string(fmtfn_t to, void *to_arg, byte* str, Uint bytes) +{ + Uint i; + + for (i = 0; i < bytes; i++) { + erts_print(to, to_arg, "%02X", str[i]); + } +} /* * Dirty BIF testing. diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index beaef0951e..e242fe9140 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -6984,6 +6984,8 @@ int erts_commit_hipe_patch_load(Eterm hipe_magic_bin) hipe_stp->new_hipe_refs = NULL; hipe_stp->new_hipe_sdesc = NULL; + hipe_redirect_to_module(modp); + return 1; } diff --git a/erts/emulator/beam/instrs.tab b/erts/emulator/beam/instrs.tab index b92152238e..f19027b1ec 100644 --- a/erts/emulator/beam/instrs.tab +++ b/erts/emulator/beam/instrs.tab @@ -936,3 +936,28 @@ build_stacktrace() { x(0) = build_stacktrace(c_p, x(0)); SWAPIN; } + +raw_raise() { + Eterm class = x(0); + Eterm value = x(1); + Eterm stacktrace = x(2); + + if (class == am_error) { + c_p->freason = EXC_ERROR & ~EXF_SAVETRACE; + c_p->fvalue = value; + c_p->ftrace = stacktrace; + goto find_func_info; + } else if (class == am_exit) { + c_p->freason = EXC_EXIT & ~EXF_SAVETRACE; + c_p->fvalue = value; + c_p->ftrace = stacktrace; + goto find_func_info; + } else if (class == am_throw) { + c_p->freason = EXC_THROWN & ~EXF_SAVETRACE; + c_p->fvalue = value; + c_p->ftrace = stacktrace; + goto find_func_info; + } else { + x(0) = am_badarg; + } +} diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index fd1b3b9c74..1f4a8eadb0 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -1584,3 +1584,4 @@ i_recv_set # build_stacktrace +raw_raise diff --git a/erts/emulator/hipe/hipe_bif0.c b/erts/emulator/hipe/hipe_bif0.c index 380031bf13..e477c4cdea 100644 --- a/erts/emulator/hipe/hipe_bif0.c +++ b/erts/emulator/hipe/hipe_bif0.c @@ -1771,7 +1771,8 @@ void hipe_redirect_to_module(Module* modp) struct hipe_mfa_info *p; struct hipe_ref_head* refh; - ERTS_LC_ASSERT(erts_thr_progress_is_blocking()); + ERTS_LC_ASSERT(erts_thr_progress_is_blocking() || + erts_is_multi_scheduling_blocked()); for (p = mod2mfa_get(modp); p; p = p->next_in_mod) { if (p->new_address) { diff --git a/erts/emulator/hipe/hipe_bif0.tab b/erts/emulator/hipe/hipe_bif0.tab index 0380e8c795..6728e20123 100644 --- a/erts/emulator/hipe/hipe_bif0.tab +++ b/erts/emulator/hipe/hipe_bif0.tab @@ -109,6 +109,7 @@ atom suspend_0 atom gc_1 atom hipe_apply atom rethrow +atom raw_raise atom find_na_or_make_stub atom nonclosure_address atom atomic_inc diff --git a/erts/emulator/hipe/hipe_bif_list.m4 b/erts/emulator/hipe/hipe_bif_list.m4 index 0562d676ae..33b3cc1ee5 100644 --- a/erts/emulator/hipe/hipe_bif_list.m4 +++ b/erts/emulator/hipe/hipe_bif_list.m4 @@ -220,6 +220,7 @@ standard_bif_interface_1(nbif_bnot_1, bnot_1) standard_bif_interface_1(nbif_set_timeout, hipe_set_timeout) standard_bif_interface_1(nbif_conv_big_to_float, hipe_conv_big_to_float) standard_bif_interface_2(nbif_rethrow, hipe_rethrow) +standard_bif_interface_3(nbif_raw_raise, hipe_raw_raise) standard_bif_interface_3(nbif_find_na_or_make_stub, hipe_find_na_or_make_stub) standard_bif_interface_2(nbif_nonclosure_address, hipe_nonclosure_address) nocons_nofail_primop_interface_0(nbif_fclearerror_error, hipe_fclearerror_error) diff --git a/erts/emulator/hipe/hipe_native_bif.c b/erts/emulator/hipe/hipe_native_bif.c index ac1480d2ed..498b43ac6b 100644 --- a/erts/emulator/hipe/hipe_native_bif.c +++ b/erts/emulator/hipe/hipe_native_bif.c @@ -314,6 +314,32 @@ BIF_RETTYPE nbif_impl_hipe_rethrow(NBIF_ALIST_2) } } +/* Called via standard_bif_interface_3 */ +BIF_RETTYPE nbif_impl_hipe_raw_raise(NBIF_ALIST_3) +{ + Process *c_p = BIF_P; + Eterm class = BIF_ARG_1; + Eterm value = BIF_ARG_2; + Eterm stacktrace = BIF_ARG_3; + Eterm reason; + + if (class == am_error) { + c_p->fvalue = value; + reason = EXC_ERROR; + } else if (class == am_exit) { + c_p->fvalue = value; + reason = EXC_EXIT; + } else if (class == am_throw) { + c_p->fvalue = value; + reason = EXC_THROWN; + } else { + return am_badarg; + } + reason &= ~EXF_SAVETRACE; + c_p->ftrace = stacktrace; + BIF_ERROR(c_p, reason); +} + /* * Support for compiled binary syntax operations. */ diff --git a/erts/emulator/hipe/hipe_native_bif.h b/erts/emulator/hipe/hipe_native_bif.h index 5711594b1e..ba42b126be 100644 --- a/erts/emulator/hipe/hipe_native_bif.h +++ b/erts/emulator/hipe/hipe_native_bif.h @@ -36,6 +36,7 @@ AEXTERN(int,nbif_suspend_msg,(void)); AEXTERN(int,nbif_suspend_msg_timeout,(void)); AEXTERN(Eterm,nbif_rethrow,(Process*, Eterm, Eterm)); +AEXTERN(Eterm,nbif_raw_raise,(Process*, Eterm, Eterm, Eterm)); AEXTERN(Eterm,nbif_set_timeout,(Process*, Eterm)); AEXTERN(Eterm,nbif_gc_1,(void)); @@ -82,6 +83,7 @@ void hipe_gc(Process*, Eterm); BIF_RETTYPE nbif_impl_hipe_set_timeout(NBIF_ALIST_1); void hipe_handle_exception(Process*); BIF_RETTYPE nbif_impl_hipe_rethrow(NBIF_ALIST_2); +BIF_RETTYPE nbif_impl_hipe_raw_raise(NBIF_ALIST_3); char *hipe_bs_allocate(int); Binary *hipe_bs_reallocate(Binary*, int); int hipe_bs_put_small_float(Process*, Eterm, Uint, byte*, unsigned, unsigned); diff --git a/erts/emulator/hipe/hipe_primops.h b/erts/emulator/hipe/hipe_primops.h index d6fd10bdff..c5f10672f3 100644 --- a/erts/emulator/hipe/hipe_primops.h +++ b/erts/emulator/hipe/hipe_primops.h @@ -46,6 +46,7 @@ PRIMOP_LIST(am_clear_timeout, &nbif_clear_timeout) PRIMOP_LIST(am_select_msg, &nbif_select_msg) PRIMOP_LIST(am_set_timeout, &nbif_set_timeout) PRIMOP_LIST(am_rethrow, &nbif_rethrow) +PRIMOP_LIST(am_raw_raise, &nbif_raw_raise) PRIMOP_LIST(am_bs_get_integer_2, &nbif_bs_get_integer_2) diff --git a/erts/emulator/sys/common/erl_sys_common_misc.c b/erts/emulator/sys/common/erl_sys_common_misc.c index 420138ff0a..96bdbacb9e 100644 --- a/erts/emulator/sys/common/erl_sys_common_misc.c +++ b/erts/emulator/sys/common/erl_sys_common_misc.c @@ -150,59 +150,50 @@ int sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, int compact) { - /* Note that some C compilers don't support "static const" propagation - * so we use a defines */ - #define SYS_DOUBLE_RND_CONST 0.55555555555555555 + #define SYS_DOUBLE_RND_CONST 0.5 #define FRAC_SIZE 52 #define EXP_SIZE 11 - #define EXP_MASK ((1ll << EXP_SIZE) - 1) + #define EXP_MASK (((Uint64)1 << EXP_SIZE) - 1) #define MAX_DECIMALS (sizeof(cs_sys_double_pow10) \ / sizeof(cs_sys_double_pow10[0])) - #define FRAC_MASK ((1ll << FRAC_SIZE) - 1) - #define FRAC_MASK2 ((1ll << (FRAC_SIZE + 1)) - 1) - #define MAX_FLOAT (1ll << (FRAC_SIZE+1)) + #define FRAC_MASK (((Uint64)1 << FRAC_SIZE) - 1) + #define FRAC_MASK2 (((Uint64)1 << (FRAC_SIZE + 1)) - 1) + #define MAX_FLOAT ((Uint64)1 << (FRAC_SIZE+1)) static const double cs_sys_double_pow10[] = { - SYS_DOUBLE_RND_CONST / 1ll, - SYS_DOUBLE_RND_CONST / 10ll, - SYS_DOUBLE_RND_CONST / 100ll, - SYS_DOUBLE_RND_CONST / 1000ll, - SYS_DOUBLE_RND_CONST / 10000ll, - SYS_DOUBLE_RND_CONST / 100000ll, - SYS_DOUBLE_RND_CONST / 1000000ll, - SYS_DOUBLE_RND_CONST / 10000000ll, - SYS_DOUBLE_RND_CONST / 100000000ll, - SYS_DOUBLE_RND_CONST / 1000000000ll, - SYS_DOUBLE_RND_CONST / 10000000000ll, - SYS_DOUBLE_RND_CONST / 100000000000ll, - SYS_DOUBLE_RND_CONST / 1000000000000ll, - SYS_DOUBLE_RND_CONST / 10000000000000ll, - SYS_DOUBLE_RND_CONST / 100000000000000ll, - SYS_DOUBLE_RND_CONST / 1000000000000000ll, - SYS_DOUBLE_RND_CONST / 10000000000000000ll, - SYS_DOUBLE_RND_CONST / 100000000000000000ll, - SYS_DOUBLE_RND_CONST / 1000000000000000000ll + SYS_DOUBLE_RND_CONST / 1e0, + SYS_DOUBLE_RND_CONST / 1e1, + SYS_DOUBLE_RND_CONST / 1e2, + SYS_DOUBLE_RND_CONST / 1e3, + SYS_DOUBLE_RND_CONST / 1e4, + SYS_DOUBLE_RND_CONST / 1e5, + SYS_DOUBLE_RND_CONST / 1e6, + SYS_DOUBLE_RND_CONST / 1e7, + SYS_DOUBLE_RND_CONST / 1e8, + SYS_DOUBLE_RND_CONST / 1e9, + SYS_DOUBLE_RND_CONST / 1e10, + SYS_DOUBLE_RND_CONST / 1e11, + SYS_DOUBLE_RND_CONST / 1e12, + SYS_DOUBLE_RND_CONST / 1e13, + SYS_DOUBLE_RND_CONST / 1e14, + SYS_DOUBLE_RND_CONST / 1e15, + SYS_DOUBLE_RND_CONST / 1e16, + SYS_DOUBLE_RND_CONST / 1e17, + SYS_DOUBLE_RND_CONST / 1e18 }; - long long mantissa, int_part = 0, frac_part = 0; - short exp; + Uint64 mantissa, int_part, frac_part; + int exp; + int fbits; int max; int neg; double fr; - union { long long L; double F; } x; + union { Uint64 L; double F; } x; char *p = buffer; if (decimals < 0) return -1; - /* Round the number to given decimal places. The number of 5's in the - * SYS_DOUBLE_RND_CONST constant is chosen such that adding any more 5's doesn't - * change the double precision of the number, i.e.: - * 1> term_to_binary(0.55555555555555555, [{minor_version, 1}]). - * <<131,70,63,225,199,28,113,199,28,114>> - * 2> term_to_binary(0.5555555555555555555, [{minor_version, 1}]). - * <<131,70,63,225,199,28,113,199,28,114>> - */ if (f >= 0) { neg = 0; fr = decimals < MAX_DECIMALS ? (f + cs_sys_double_pow10[decimals]) : f; @@ -233,7 +224,7 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, } exp -= EXP_MASK >> 1; - mantissa |= (1ll << FRAC_SIZE); + mantissa |= ((Uint64)1 << FRAC_SIZE); /* Don't bother with optimizing too large numbers or too large precision */ if (x.F > MAX_FLOAT || decimals >= MAX_DECIMALS) { @@ -248,11 +239,16 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, return p - buffer; } else if (exp >= FRAC_SIZE) { int_part = mantissa << (exp - FRAC_SIZE); + frac_part = 0; + fbits = FRAC_SIZE; /* not important as frac_part==0 */ } else if (exp >= 0) { - int_part = mantissa >> (FRAC_SIZE - exp); - frac_part = (mantissa << (exp + 1)) & FRAC_MASK2; + fbits = FRAC_SIZE - exp; + int_part = mantissa >> fbits; + frac_part = mantissa & (((Uint64)1 << fbits) -1); } else /* if (exp < 0) */ { - frac_part = (mantissa & FRAC_MASK2) >> -(exp + 1); + int_part = 0; + frac_part = mantissa; + fbits = FRAC_SIZE - exp; } if (!int_part) { @@ -262,9 +258,8 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, } else { int ret, i, n; while (int_part != 0) { - long long j = int_part / 10; - *p++ = (char)(int_part - ((j << 3) + (j << 1)) + '0'); - int_part = j; + *p++ = (char)((int_part % 10) + '0'); + int_part /= 10; } if (neg) *p++ = '-'; @@ -290,11 +285,22 @@ sys_double_to_chars_fast(double f, char *buffer, int buffer_size, int decimals, max = decimals; for (i = 0; i < max; i++) { - /* frac_part *= 10; */ - frac_part = (frac_part << 3) + (frac_part << 1); - - *p++ = (char)((frac_part >> (FRAC_SIZE + 1)) + '0'); - frac_part &= FRAC_MASK2; + if (frac_part > (ERTS_UINT64_MAX/5)) { + frac_part >>= 3; + fbits -= 3; + } + + /* Multiply by 10 (5*2) to extract decimal digit as integer part */ + frac_part *= 5; + fbits--; + + if (fbits >= 64) { + *p++ = '0'; + } + else { + *p++ = (char)((frac_part >> fbits) + '0'); + frac_part &= ((Uint64)1 << fbits) - 1; + } } /* Delete trailing zeroes */ diff --git a/erts/emulator/test/num_bif_SUITE.erl b/erts/emulator/test/num_bif_SUITE.erl index 7fb132c587..592542405f 100644 --- a/erts/emulator/test/num_bif_SUITE.erl +++ b/erts/emulator/test/num_bif_SUITE.erl @@ -118,6 +118,7 @@ t_float(Config) when is_list(Config) -> %% Tests float_to_list/1, float_to_list/2, float_to_binary/1, float_to_binary/2 t_float_to_string(Config) when is_list(Config) -> + rand_seed(), test_fts("0.00000000000000000000e+00", 0.0), test_fts("2.50000000000000000000e+01", 25.0), test_fts("2.50000000000000000000e+00", 2.5), @@ -167,8 +168,8 @@ t_float_to_string(Config) when is_list(Config) -> test_fts("1.12300",1.123, [{decimals, 5}]), test_fts("1.123",1.123, [{decimals, 5}, compact]), test_fts("1.1234",1.1234,[{decimals, 6}, compact]), - test_fts("1.01",1.005, [{decimals, 2}]), - test_fts("-1.01",-1.005,[{decimals, 2}]), + test_fts("1.00",1.005, [{decimals, 2}]), %% 1.005 is really 1.0049999999... + test_fts("-1.00",-1.005,[{decimals, 2}]), test_fts("0.999",0.999, [{decimals, 3}]), test_fts("-0.999",-0.999,[{decimals, 3}]), test_fts("1.0",0.999, [{decimals, 2}, compact]), @@ -184,6 +185,9 @@ t_float_to_string(Config) when is_list(Config) -> test_fts("123000000000000000000.0",1.23e20, [{decimals, 10}, compact]), test_fts("1.2300000000e+20",1.23e20, [{scientific, 10}, compact]), test_fts("1.23000000000000000000e+20",1.23e20, []), + + fts_rand_float_decimals(1000), + ok. test_fts(Expect, Float) -> @@ -197,6 +201,49 @@ test_fts(Expect, Float, Args) -> BinExpect = float_to_binary(Float,Args). +rand_float_reasonable() -> + F = rand_float(), + case abs(F) > 1.0e238 of + true -> rand_float_reasonable(); + false -> F + end. + +fts_rand_float_decimals(0) -> ok; +fts_rand_float_decimals(N) -> + [begin + F0 = rand_float_reasonable(), + L0 = float_to_list(F0, [{decimals, D}]), + L1 = case D of + 0 -> L0 ++ ".0"; + _ -> L0 + end, + F1 = list_to_float(L1), + Diff = abs(F0-F1), + MaxDiff = max_diff_decimals(F0, D), + ok = case Diff =< MaxDiff of + true -> ok; + false -> + io:format("F0 = ~w ~w\n", [F0, <<F0/float>>]), + io:format("L1 = ~s\n", [L1]), + io:format("F1 = ~w ~w\n", [F1, <<F1/float>>]), + io:format("Diff = ~w, MaxDiff = ~w\n", [Diff, MaxDiff]), + error + end + end + || D <- lists:seq(0,15)], + + fts_rand_float_decimals(N-1). + +max_diff_decimals(F, D) -> + IntBits = floor(math:log2(abs(F))) + 1, + FracBits = (52 - IntBits), + Log10_2 = 0.3010299956639812, % math:log10(2) + MaxDec = floor(FracBits * Log10_2), + + Resolution = math:pow(2, IntBits - 53), + + (math:pow(10, -min(D,MaxDec)) / 2) + Resolution. + %% Tests list_to_float/1. t_string_to_float_safe(Config) when is_list(Config) -> @@ -331,18 +378,26 @@ t_trunc_and_friends(_Config) -> -18446744073709551616 = trunc_and_friends(-float(1 bsl 64)), %% Random. + rand_seed(), t_trunc_and_friends_rand(100), ok. +rand_seed() -> + rand:seed(exrop), + io:format("\n*** rand:export_seed() = ~w\n\n", [rand:export_seed()]), + ok. + +rand_float() -> + F0 = rand:uniform() * math:pow(10, 50*rand:normal()), + case rand:uniform() of + U when U < 0.5 -> -F0; + _ -> F0 + end. + t_trunc_and_friends_rand(0) -> ok; t_trunc_and_friends_rand(N) -> - F0 = rand:uniform() * math:pow(10, 50*rand:normal()), - F = case rand:uniform() of - U when U < 0.5 -> -F0; - _ -> F0 - end, - _ = trunc_and_friends(F), + _ = trunc_and_friends(rand_float()), t_trunc_and_friends_rand(N-1). trunc_and_friends(F) -> diff --git a/erts/lib_src/common/erl_printf_format.c b/erts/lib_src/common/erl_printf_format.c index 3daa066fd3..3302083288 100644 --- a/erts/lib_src/common/erl_printf_format.c +++ b/erts/lib_src/common/erl_printf_format.c @@ -331,7 +331,7 @@ static int fmt_double(fmtfn_t fn,void*arg,double val, char *bufp = sbuf; double dexp; int exp; - size_t max_size = 1; + size_t max_size = 2; /* including possible sign */ int size; int new_fmt = fmt; int fpe_was_unmasked; diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index da944f3ce6..dbbaae05eb 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -294,24 +294,25 @@ backward([{jump,{f,To}}=J|[{gc_bif,_,{f,To},_,_,_Dst}|Is]], D, Acc) -> %% register is initialized, and it is therefore no need to test %% for liveness of the destination register at label To. backward([J|Is], D, Acc); -backward([{test,bs_start_match2,F,Live,[R,_]=Args,Ctxt}|Is], D, - [{test,bs_match_string,F,[Ctxt,Bs]}, - {test,bs_test_tail2,F,[Ctxt,0]}|Acc0]=Acc) -> +backward([{test,bs_start_match2,F,Live,[Src,_]=Args,Ctxt}|Is], D, Acc0) -> {f,To0} = F, - case beam_utils:is_killed(Ctxt, Acc0, D) of - true -> - To = shortcut_bs_context_to_binary(To0, R, D), - Eq = {test,is_eq_exact,{f,To},[R,{literal,Bs}]}, - backward(Is, D, [Eq|Acc0]); - false -> - To = shortcut_bs_start_match(To0, R, D), - I = {test,bs_start_match2,{f,To},Live,Args,Ctxt}, - backward(Is, D, [I|Acc]) + case test_bs_literal(F, Ctxt, D, Acc0) of + {none,Acc} -> + %% Ctxt killed immediately after bs_start_match2. + To = shortcut_bs_context_to_binary(To0, Src, D), + I = {test,is_bitstr,{f,To},[Src]}, + backward(Is, D, [I|Acc]); + {Literal,Acc} -> + %% Ctxt killed after matching a literal. + To = shortcut_bs_context_to_binary(To0, Src, D), + Eq = {test,is_eq_exact,{f,To},[Src,{literal,Literal}]}, + backward(Is, D, [Eq|Acc]); + not_killed -> + %% Ctxt not killed. Not much to do. + To = shortcut_bs_start_match(To0, Src, D), + I = {test,bs_start_match2,{f,To},Live,Args,Ctxt}, + backward(Is, D, [I|Acc0]) end; -backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) -> - To = shortcut_bs_start_match(To0, Src, D), - I = {test,bs_start_match2,{f,To},Live,Info,Dst}, - backward(Is, D, [I|Acc]); backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) -> To1 = shortcut_bs_test(To0, Is, D), To2 = shortcut_label(To1, D), @@ -511,6 +512,22 @@ remove_from_list(Lit, [Val,{f,_}=Fail|T]) -> [Val,Fail|remove_from_list(Lit, T)]; remove_from_list(_, []) -> []. + +test_bs_literal(F, Ctxt, D, + [{test,bs_match_string,F,[Ctxt,Bs]}, + {test,bs_test_tail2,F,[Ctxt,0]}|Acc]) -> + test_bs_literal_1(Ctxt, Acc, D, Bs); +test_bs_literal(F, Ctxt, D, [{test,bs_test_tail2,F,[Ctxt,0]}|Acc]) -> + test_bs_literal_1(Ctxt, Acc, D, <<>>); +test_bs_literal(_, Ctxt, D, Acc) -> + test_bs_literal_1(Ctxt, Acc, D, none). + +test_bs_literal_1(Ctxt, Is, D, Literal) -> + case beam_utils:is_killed(Ctxt, Is, D) of + true -> {Literal,Is}; + false -> not_killed + end. + %% shortcut_bs_test(TargetLabel, ReversedInstructions, D) -> TargetLabel' %% Try to shortcut the failure label for bit syntax matching. diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 22ba86fa38..50b76d7f29 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1088,6 +1088,8 @@ resolve_inst({get_map_elements,Args0},_,_,_) -> resolve_inst({build_stacktrace,[]},_,_,_) -> build_stacktrace; +resolve_inst({raw_raise,[]},_,_,_) -> + raw_raise; %% %% Catches instructions that are not yet handled. diff --git a/lib/compiler/src/beam_disasm.hrl b/lib/compiler/src/beam_disasm.hrl index 8cc0bcf99b..c3326c15a0 100644 --- a/lib/compiler/src/beam_disasm.hrl +++ b/lib/compiler/src/beam_disasm.hrl @@ -27,7 +27,7 @@ %% PROPER TYPES FOR THE SET OF BEAM INSTRUCTIONS. %% -type beam_instr() :: 'bs_init_writable' | 'build_stacktrace' - | 'fclearerror' | 'if_end' + | 'fclearerror' | 'if_end' | 'raw_raise' | 'remove_message' | 'return' | 'send' | 'timeout' | tuple(). %% XXX: Very underspecified - FIX THIS diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 3b6bf49961..b2fabed2c5 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -80,96 +80,99 @@ simplify(Is0, TypeDb0) -> %% Basic simplification, mostly tuples, no floating point optimizations. simplify_basic(Is, Ts) -> - simplify_basic_1(Is, Ts, []). - -simplify_basic_1([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is], Ts0, Acc) -> - I = case max_tuple_size(Reg, Ts0) of - Sz when 0 < Index, Index =< Sz -> - {set,[D],[Reg],{get_tuple_element,Index-1}}; - _Other -> I0 - end, - Ts = update(I, Ts0), - simplify_basic_1(Is, Ts, [I|Acc]); -simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) -> - case tdb_find(TupleReg, Ts0) of - {tuple,_,_,[Contents]} -> - simplify_basic_1([{set,[D],[Contents],move}|Is0], Ts0, Acc); - _ -> - Ts = update(I, Ts0), - simplify_basic_1(Is0, Ts, [I|Acc]) + simplify_basic(Is, Ts, []). + +simplify_basic([I0|Is], Ts0, Acc) -> + case simplify_instr(I0, Ts0) of + [] -> + simplify_basic(Is, Ts0, Acc); + [I] -> + Ts = update(I, Ts0), + simplify_basic(Is, Ts, [I|Acc]) + end; +simplify_basic([], Ts, Acc) -> + {reverse(Acc),Ts}. + +simplify_instr({set,[D],[{integer,Index},Reg],{bif,element,_}}=I, Ts) -> + case max_tuple_size(Reg, Ts) of + Sz when 0 < Index, Index =< Sz -> + [{set,[D],[Reg],{get_tuple_element,Index-1}}]; + _ -> [I] + end; +simplify_instr({test,is_atom,_,[R]}=I, Ts) -> + case tdb_find(R, Ts) of + boolean -> []; + _ -> [I] end; -simplify_basic_1([{set,_,_,{try_catch,_,_}}=I|Is], _Ts, Acc) -> - simplify_basic_1(Is, tdb_new(), [I|Acc]); -simplify_basic_1([{test,is_atom,_,[R]}=I|Is], Ts, Acc) -> +simplify_instr({test,is_integer,_,[R]}=I, Ts) -> + case tdb_find(R, Ts) of + integer -> []; + {integer,_} -> []; + _ -> [I] + end; +simplify_instr({set,[D],[TupleReg],{get_tuple_element,0}}=I, Ts) -> + case tdb_find(TupleReg, Ts) of + {tuple,_,_,[Contents]} -> + [{set,[D],[Contents],move}]; + _ -> + [I] + end; +simplify_instr({test,is_tuple,_,[R]}=I, Ts) -> case tdb_find(R, Ts) of - boolean -> simplify_basic_1(Is, Ts, Acc); - _ -> simplify_basic_1(Is, Ts, [I|Acc]) + {tuple,_,_,_} -> []; + _ -> [I] end; -simplify_basic_1([{test,is_integer,_,[R]}=I|Is], Ts, Acc) -> +simplify_instr({test,test_arity,_,[R,Arity]}=I, Ts) -> case tdb_find(R, Ts) of - integer -> simplify_basic_1(Is, Ts, Acc); - {integer,_} -> simplify_basic_1(Is, Ts, Acc); - _ -> simplify_basic_1(Is, Ts, [I|Acc]) + {tuple,exact_size,Arity,_} -> []; + _ -> [I] end; -simplify_basic_1([{test,is_tuple,_,[R]}=I|Is], Ts, Acc) -> +simplify_instr({test,is_map,_,[R]}=I, Ts) -> case tdb_find(R, Ts) of - {tuple,_,_,_} -> simplify_basic_1(Is, Ts, Acc); - _ -> simplify_basic_1(Is, Ts, [I|Acc]) + map -> []; + _ -> [I] end; -simplify_basic_1([{test,test_arity,_,[R,Arity]}=I|Is], Ts0, Acc) -> - case tdb_find(R, Ts0) of - {tuple,exact_size,Arity,_} -> - simplify_basic_1(Is, Ts0, Acc); - _Other -> - Ts = update(I, Ts0), - simplify_basic_1(Is, Ts, [I|Acc]) +simplify_instr({test,is_nonempty_list,_,[R]}=I, Ts) -> + case tdb_find(R, Ts) of + nonempty_list -> []; + _ -> [I] end; -simplify_basic_1([{test,is_map,_,[R]}=I|Is], Ts0, Acc) -> - case tdb_find(R, Ts0) of - map -> simplify_basic_1(Is, Ts0, Acc); - _Other -> - Ts = update(I, Ts0), - simplify_basic_1(Is, Ts, [I|Acc]) +simplify_instr({test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I, Ts) -> + case tdb_find(R, Ts) of + {atom,_}=Atom -> []; + {atom,_} -> [{jump,Fail}]; + _ -> [I] end; -simplify_basic_1([{test,is_nonempty_list,_,[R]}=I|Is], Ts0, Acc) -> - case tdb_find(R, Ts0) of - nonempty_list -> simplify_basic_1(Is, Ts0, Acc); - _Other -> - Ts = update(I, Ts0), - simplify_basic_1(Is, Ts, [I|Acc]) - end; -simplify_basic_1([{test,is_eq_exact,Fail,[R,{atom,_}=Atom]}=I|Is0], Ts0, Acc0) -> - Acc = case tdb_find(R, Ts0) of - {atom,_}=Atom -> Acc0; - {atom,_} -> [{jump,Fail}|Acc0]; - _ -> [I|Acc0] - end, - Ts = update(I, Ts0), - simplify_basic_1(Is0, Ts, Acc); -simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0, Acc) -> - case tdb_find(R, Ts0) of - {tuple,exact_size,Arity,[Tag]} -> - simplify_basic_1(Is, Ts0, Acc); - _Other -> - Ts = update(I, Ts0), - simplify_basic_1(Is, Ts, [I|Acc]) - end; -simplify_basic_1([{select,select_val,Reg,_,_}=I0|Is], Ts, Acc) -> - I = case tdb_find(Reg, Ts) of - {integer,Range} -> - simplify_select_val_int(I0, Range); - boolean -> - simplify_select_val_bool(I0); - _ -> - I0 - end, - simplify_basic_1(Is, tdb_new(), [I|Acc]); -simplify_basic_1([I|Is], Ts0, Acc) -> - Ts = update(I, Ts0), - simplify_basic_1(Is, Ts, [I|Acc]); -simplify_basic_1([], Ts, Acc) -> - Is = reverse(Acc), - {Is,Ts}. +simplify_instr({test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I, Ts) -> + case tdb_find(R, Ts) of + {tuple,exact_size,Arity,[Tag]} -> []; + _ -> [I] + end; +simplify_instr({select,select_val,Reg,_,_}=I, Ts) -> + [case tdb_find(Reg, Ts) of + {integer,Range} -> + simplify_select_val_int(I, Range); + boolean -> + simplify_select_val_bool(I); + _ -> + I + end]; +simplify_instr({test,bs_test_unit,_,[Src,Unit]}=I, Ts) -> + case tdb_find(Src, Ts) of + {binary,U} when U rem Unit =:= 0 -> []; + _ -> [I] + end; +simplify_instr({test,is_binary,_,[Src]}=I, Ts) -> + case tdb_find(Src, Ts) of + {binary,U} when U rem 8 =:= 0 -> []; + _ -> [I] + end; +simplify_instr({test,is_bitstr,_,[Src]}=I, Ts) -> + case tdb_find(Src, Ts) of + {binary,_} -> []; + _ -> [I] + end; +simplify_instr(I, _) -> [I]. simplify_select_val_int({select,select_val,R,_,L0}=I, {Min,Max}) -> Vs = sort([V || {integer,V} <- L0]), @@ -504,8 +507,12 @@ update({test,is_eq_exact,_,[Reg,{atom,_}=Atom]}, Ts) -> update({test,is_record,_Fail,[Src,Tag,{integer,Arity}]}, Ts) -> tdb_update([{Src,{tuple,exact_size,Arity,[Tag]}}], Ts); -%% Binary matching +%% Binaries and binary matching. +update({test,is_binary,_Fail,[Src]}, Ts0) -> + tdb_update([{Src,{binary,8}}], Ts0); +update({test,is_bitstr,_Fail,[Src]}, Ts0) -> + tdb_update([{Src,{binary,1}}], Ts0); update({test,bs_get_integer2,_,_,Args,Dst}, Ts) -> tdb_update([{Dst,get_bs_integer_type(Args)}], Ts); update({test,bs_get_utf8,_,_,_,Dst}, Ts) -> @@ -514,8 +521,10 @@ update({test,bs_get_utf16,_,_,_,Dst}, Ts) -> tdb_update([{Dst,?UNICODE_INT}], Ts); update({test,bs_get_utf32,_,_,_,Dst}, Ts) -> tdb_update([{Dst,?UNICODE_INT}], Ts); +update({bs_init,_,{bs_init2,_,_},_,_,Dst}, Ts) -> + tdb_update([{Dst,{binary,8}}], Ts); update({bs_init,_,_,_,_,Dst}, Ts) -> - tdb_update([{Dst,kill}], Ts); + tdb_update([{Dst,{binary,1}}], Ts); update({bs_put,_,_,_}, Ts) -> Ts; update({bs_save2,_,_}, Ts) -> @@ -524,12 +533,19 @@ update({bs_restore2,_,_}, Ts) -> Ts; update({bs_context_to_binary,Dst}, Ts) -> tdb_update([{Dst,kill}], Ts); -update({test,bs_start_match2,_,_,_,Dst}, Ts) -> - tdb_update([{Dst,kill}], Ts); -update({test,bs_get_binary2,_,_,_,Dst}, Ts) -> - tdb_update([{Dst,kill}], Ts); +update({test,bs_start_match2,_,_,[Src,_],Dst}, Ts) -> + Type = case tdb_find(Src, Ts) of + {binary,_}=Type0 -> Type0; + _ -> {binary,1} + end, + tdb_update([{Dst,Type}], Ts); +update({test,bs_get_binary2,_,_,[_,_,Unit,_],Dst}, Ts) -> + true = is_integer(Unit), %Assertion. + tdb_update([{Dst,{binary,Unit}}], Ts); update({test,bs_get_float2,_,_,_,Dst}, Ts) -> tdb_update([{Dst,float}], Ts); +update({test,bs_test_unit,_,[Src,Unit]}, Ts) -> + tdb_update([{Src,{binary,Unit}}], Ts); update({test,_Test,_Fail,_Other}, Ts) -> Ts; @@ -566,6 +582,7 @@ update({call_fun, _}, Ts) -> tdb_kill_xregs(Ts); update({apply, _}, Ts) -> tdb_kill_xregs(Ts); update({line,_}, Ts) -> Ts; +update({'%',_}, Ts) -> Ts; %% The instruction is unknown. Kill all information. update(_I, _Ts) -> tdb_new(). @@ -804,6 +821,9 @@ checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. %%% %%% 'integer' or {integer,{Min,Max}} that the register contains an %%% integer. +%%% +%%% {binary,Unit} means that the register contains a binary/bitstring aligned +%%% to unit Unit. %% tdb_new() -> EmptyDataBase %% Creates a new, empty type database. @@ -929,11 +949,14 @@ merge_type_info({integer,_}=Int, integer) -> Int; merge_type_info({integer,{Min1,Max1}}, {integer,{Min2,Max2}}) -> {integer,{max(Min1, Min2),min(Max1, Max2)}}; +merge_type_info({binary,U1}, {binary,U2}) -> + {binary,max(U1, U2)}; merge_type_info(NewType, _) -> verify_type(NewType), NewType. verify_type({atom,_}) -> ok; +verify_type({binary,U}) when is_integer(U) -> ok; verify_type(boolean) -> ok; verify_type(integer) -> ok; verify_type({integer,{Min,Max}}) diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 901588ee3b..5333925589 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -871,6 +871,8 @@ live_opt([{block,Bl0}|Is], Regs0, D, Acc) -> live_opt(Is, Regs, D, [{block,[Live|Bl]}|Acc]); live_opt([build_stacktrace=I|Is], _, D, Acc) -> live_opt(Is, live_call(1), D, [I|Acc]); +live_opt([raw_raise=I|Is], _, D, Acc) -> + live_opt(Is, live_call(3), D, [I|Acc]); live_opt([{label,L}=I|Is], Regs, D0, Acc) -> D = gb_trees:insert(L, Regs, D0), live_opt(Is, Regs, D, [I|Acc]); @@ -1142,6 +1144,8 @@ defs([{move,_,Dst}=I|Is], Regs0, D) -> defs([{put_map,{f,Fail},_,_,Dst,_,_}=I|Is], Regs0, D) -> Regs = def_regs([Dst], Regs0), [I|defs(Is, Regs, update_regs(Fail, Regs0, D))]; +defs([raw_raise=I|Is], _Regs, D) -> + [I|defs(Is, 1, D)]; defs([return=I|Is], _Regs, D) -> [I|defs_unreachable(Is, D)]; defs([{select,_,_Src,Fail,List}=I|Is], Regs, D0) -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index ca757f5e47..f8bf935132 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -537,6 +537,8 @@ valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> valfun_4({bif,raise,{f,0},Src,_Dst}, Vst) -> validate_src(Src, Vst), kill_state(Vst); +valfun_4(raw_raise=I, Vst) -> + call(I, 3, Vst); valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) -> validate_src(Src, Vst0), Vst = branch_state(Fail, Vst0), diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab index 397e478e1e..d59bb241a8 100755 --- a/lib/compiler/src/genop.tab +++ b/lib/compiler/src/genop.tab @@ -554,3 +554,13 @@ BEAM_FORMAT_NUMBER=0 ## Do a garbage collection if necessary to allocate space on the heap ## for the result. 160: build_stacktrace/0 + +## @spec raw_raise +## @doc This instruction works like the erlang:raise/3 BIF, except that the +## stacktrace in x(2) must be a raw stacktrace. +## x(0) is the class of the exception (error, exit, or throw), +## x(1) is the exception term, and x(2) is the raw stackframe. +## If x(0) is not a valid class, the instruction will not throw an +## exception, but store the atom 'badarg' in x(0) and execute the +## next instruction. +161: raw_raise/0 diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 46816fe24a..a9bd363ee1 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -2507,6 +2507,72 @@ are_all_failing_clauses(Cs) -> is_failing_clause(#c_clause{body=B}) -> will_fail(B). +%% opt_build_stacktrace(Let) -> Core. +%% If the stacktrace is *only* used in a call to erlang:raise/3, +%% there is no need to build a cooked stackframe using build_stacktrace/1. + +opt_build_stacktrace(#c_let{vars=[#c_var{name=Cooked}], + arg=#c_primop{name=#c_literal{val=build_stacktrace}, + args=[RawStk]}, + body=Body}=Let) -> + case Body of + #c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=raise}, + args=[Class,Exp,#c_var{name=Cooked}]} -> + %% The stacktrace is only used in a call to erlang:raise/3. + %% There is no need to build the stacktrace. Replace the + %% call to erlang:raise/3 with the the raw_raise/3 instruction, + %% which will use a raw stacktrace. + #c_primop{name=#c_literal{val=raw_raise}, + args=[Class,Exp,RawStk]}; + #c_let{vars=[#c_var{name=V}],arg=Arg,body=B0} when V =/= Cooked -> + case core_lib:is_var_used(Cooked, Arg) of + false -> + %% The built stacktrace is not used in the argument, + %% so we can sink the building of the stacktrace into + %% the body of the let. + B = opt_build_stacktrace(Let#c_let{body=B0}), + Body#c_let{body=B}; + true -> + Let + end; + #c_seq{arg=Arg,body=B0} -> + case core_lib:is_var_used(Cooked, Arg) of + false -> + %% The built stacktrace is not used in the argument, + %% so we can sink the building of the stacktrace into + %% the body of the sequence. + B = opt_build_stacktrace(Let#c_let{body=B0}), + Body#c_seq{body=B}; + true -> + Let + end; + #c_case{arg=Arg,clauses=Cs0} -> + case core_lib:is_var_used(Cooked, Arg) orelse + is_used_in_any_guard(Cooked, Cs0) of + false -> + %% The built stacktrace is not used in the argument, + %% so we can sink the building of the stacktrace into + %% each arm of the case. + Cs = [begin + B = opt_build_stacktrace(Let#c_let{body=B0}), + C#c_clause{body=B} + end || #c_clause{body=B0}=C <- Cs0], + Body#c_case{clauses=Cs}; + true -> + Let + end; + _ -> + Let + end; +opt_build_stacktrace(Expr) -> + Expr. + +is_used_in_any_guard(V, Cs) -> + any(fun(#c_clause{guard=G}) -> + core_lib:is_var_used(V, G) + end, Cs). + %% opt_case_in_let(Let) -> Let' %% Try to avoid building tuples that are immediately matched. %% A common pattern is: @@ -2712,8 +2778,9 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, PrevBody, Sub) -> %% Note that the substitutions and scope in Sub have been cleared %% and should not be used. -post_opt_let(Let, Sub) -> - opt_bool_case_in_let(Let, Sub). +post_opt_let(Let0, Sub) -> + Let1 = opt_bool_case_in_let(Let0, Sub), + opt_build_stacktrace(Let1). %% remove_first_value(Core0, Sub) -> Core. diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 8f3399d133..a96d58a903 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1855,7 +1855,12 @@ internal_cg(guard_error, [ExitCall], _Rs, Le, Vdb, Bef, St) -> {Ms,_} = cg_call_args(As, Bef, Le#l.i, Vdb), Call = {call_ext,Arity,{extfunc,Mod,Name,Arity}}, Is = Ms++[line(Le),Call], - {Is,Bef,St}. + {Is,Bef,St}; +internal_cg(raw_raise=I, As, Rs, Le, Vdb, Bef, St) -> + %% This behaves like a function call. + {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), + Reg = load_vars(Rs, clear_regs(Int#sr.reg)), + {Sis++[I],clear_dead(Int#sr{reg=Reg}, Le#l.i, Vdb),St}. %% bif_cg(Bif, [Arg], [Ret], Le, Vdb, StackReg, State) -> %% {[Ainstr],StackReg,State}. diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index fe856b12b6..dfbf2aa4a0 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -23,7 +23,7 @@ init_per_group/2,end_per_group/2, integers/1,coverage/1,booleans/1,setelement/1,cons/1, tuple/1,record_float/1,binary_float/1,float_compare/1, - arity_checks/1]). + arity_checks/1,elixir_binaries/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -42,7 +42,8 @@ groups() -> record_float, binary_float, float_compare, - arity_checks + arity_checks, + elixir_binaries ]}]. init_per_suite(Config) -> @@ -199,5 +200,42 @@ do_tuple_arity_check(RGB) when is_tuple(RGB), _ -> ok end. +elixir_binaries(_Config) -> + <<"foo blitzky baz">> = elixir_binary_1(<<"blitzky">>), + <<"foo * baz">> = elixir_binary_2($*), + <<7:4,755:10>> = elixir_bitstring_3(<<755:10>>), + ok. + +elixir_binary_1(Bar) when is_binary(Bar) -> + <<"foo ", + case Bar of + Rewrite when is_binary(Rewrite) -> + Rewrite; + Rewrite -> + list_to_binary(Rewrite) + end/binary, + " baz">>. + +elixir_binary_2(Arg) -> + Bin = <<Arg>>, + <<"foo ", + case Bin of + Rewrite when is_binary(Rewrite) -> + Rewrite; + Rewrite -> + list_to_binary:to_string(Rewrite) + end/binary, + " baz">>. + +elixir_bitstring_3(Bar) when is_bitstring(Bar) -> + <<7:4, + case Bar of + Rewrite when is_bitstring(Rewrite) -> + Rewrite; + Rewrite -> + list_to_bitstring(Rewrite) + end/bitstring>>. + + id(I) -> I. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 4bd5e8e2e1..235956a714 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -678,6 +678,10 @@ coverage(Config) when is_list(Config) -> <<>> = coverage_per_key(<<4:32>>), <<$a,$b,$c>> = coverage_per_key(<<7:32,"abc">>), + binary = coverage_bitstring(<<>>), + binary = coverage_bitstring(<<7>>), + bitstring = coverage_bitstring(<<7:4>>), + other = coverage_bitstring([a]), ok. coverage_fold(Fun, Acc, <<H,T/binary>>) -> @@ -768,6 +772,10 @@ coverage_per_key(<<BinSize:32,Bin/binary>> = B) -> true = (byte_size(B) =:= BinSize), Bin. +coverage_bitstring(Bin) when is_binary(Bin) -> binary; +coverage_bitstring(<<_/bitstring>>) -> bitstring; +coverage_bitstring(_) -> other. + multiple_uses(Config) when is_list(Config) -> {344,62879,345,<<245,159,1,89>>} = multiple_uses_1(<<1,88,245,159,1,89>>), true = multiple_uses_2(<<0,0,197,18>>), diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 8cf7928cc4..d5a1dc642f 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -27,7 +27,7 @@ nested_horrid/1,last_call_optimization/1,bool/1, plain_catch_coverage/1,andalso_orelse/1,get_in_try/1, hockey/1,handle_info/1,catch_in_catch/1,grab_bag/1, - stacktrace/1,nested_stacktrace/1]). + stacktrace/1,nested_stacktrace/1,raise/1]). -include_lib("common_test/include/ct.hrl"). @@ -44,7 +44,7 @@ groups() -> nested_after,nested_horrid,last_call_optimization, bool,plain_catch_coverage,andalso_orelse,get_in_try, hockey,handle_info,catch_in_catch,grab_bag, - stacktrace,nested_stacktrace]}]. + stacktrace,nested_stacktrace,raise]}]. init_per_suite(Config) -> @@ -117,6 +117,16 @@ basic(Conf) when is_list(Conf) -> catch nisse -> erro end, + %% Unmatchable clauses. + try + throw(thrown) + catch + {a,b}={a,b,c} -> %Intentionally no match. + ok; + thrown -> + ok + end, + ok. after_call() -> @@ -1159,5 +1169,99 @@ nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> {caught1,S1,T2} end. +raise(_Config) -> + test_raise(fun() -> exit({exit,tuple}) end), + test_raise(fun() -> abs(id(x)) end), + test_raise(fun() -> throw({was,thrown}) end), + + badarg = bad_raise(fun() -> abs(id(x)) end), + + ok. + +bad_raise(Expr) -> + try + Expr() + catch + _:E:Stk -> + erlang:raise(bad_class, E, Stk) + end. + +test_raise(Expr) -> + test_raise_1(Expr), + test_raise_2(Expr), + test_raise_3(Expr). + +test_raise_1(Expr) -> + erase(exception), + try + do_test_raise_1(Expr) + catch + C:E:Stk -> + {C,E,Stk} = erase(exception) + end. + +do_test_raise_1(Expr) -> + try + Expr() + catch + C:E:Stk -> + %% Here the stacktrace must be built. + put(exception, {C,E,Stk}), + erlang:raise(C, E, Stk) + end. + +test_raise_2(Expr) -> + erase(exception), + try + do_test_raise_2(Expr) + catch + C:E:Stk -> + {C,E} = erase(exception), + try + Expr() + catch + _:_:S -> + [StkTop|_] = S, + [StkTop|_] = Stk + end + end. + +do_test_raise_2(Expr) -> + try + Expr() + catch + C:E:Stk -> + %% Here it is possible to replace erlang:raise/3 with + %% the raw_raise/3 instruction since the stacktrace is + %% not actually used. + put(exception, {C,E}), + erlang:raise(C, E, Stk) + end. + +test_raise_3(Expr) -> + try + do_test_raise_3(Expr) + catch + exit:{exception,C,E}:Stk -> + try + Expr() + catch + C:E:S -> + [StkTop|_] = S, + [StkTop|_] = Stk + end + end. + +do_test_raise_3(Expr) -> + try + Expr() + catch + C:E:Stk -> + %% Here it is possible to replace erlang:raise/3 with + %% the raw_raise/3 instruction since the stacktrace is + %% not actually used. + erlang:raise(exit, {exception,C,E}, Stk) + end. + id(I) -> I. diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 93cfea3c5e..384912f983 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -3117,7 +3117,10 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State, state__remove_added_warnings(OldState, NewState) -> #state{warnings = OldWarnings} = OldState, #state{warnings = NewWarnings} = NewState, - {NewWarnings -- OldWarnings, NewState#state{warnings = OldWarnings}}. + case NewWarnings =:= OldWarnings of + true -> {[], NewState}; + false -> {NewWarnings -- OldWarnings, NewState#state{warnings = OldWarnings}} + end. state__add_warnings(Warns, #state{warnings = Warnings} = State) -> State#state{warnings = Warns ++ Warnings}. diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 7ff9fd83eb..6e66ec057c 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -1164,6 +1164,12 @@ trans_fun([build_stacktrace|Instructions], Env) -> Vars = [mk_var({x,0})], %{x,0} is implict arg and dst [hipe_icode:mk_primop(Vars,build_stacktrace,Vars), trans_fun(Instructions, Env)]; +%%--- raw_raise --- +trans_fun([raw_raise|Instructions], Env) -> + Vars = [mk_var({x,0}),mk_var({x,1}),mk_var({x,2})], + Dst = [mk_var({x,0})], + [hipe_icode:mk_primop(Dst,raw_raise,Vars) | + trans_fun(Instructions, Env)]; %%-------------------------------------------------------------------- %%--- ERROR HANDLING --- %%-------------------------------------------------------------------- diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl index 941516e8b1..a1f1128124 100644 --- a/lib/hipe/icode/hipe_icode_primops.erl +++ b/lib/hipe/icode/hipe_icode_primops.erl @@ -236,6 +236,7 @@ fails({hipe_bs_primop, {bs_append, _, _, _, _}}) -> true; fails({hipe_bs_primop, {bs_private_append, _, _}}) -> true; fails({hipe_bs_primop, bs_init_writable}) -> true; fails(build_stacktrace) -> false; +fails(raw_raise) -> true; fails(#mkfun{}) -> false; fails(#unsafe_element{}) -> false; fails(#unsafe_update_element{}) -> false; @@ -735,6 +736,8 @@ type(Primop, Args) -> erl_types:t_any(); build_stacktrace -> erl_types:t_list(); + raw_raise -> + erl_types:t_atom(); {M, F, A} -> erl_bif_types:type(M, F, A, Args) end. @@ -909,6 +912,8 @@ type(Primop) -> %%% Other build_stacktrace -> erl_types:t_any(); + raw_raise -> + erl_types:t_any(); #closure_element{} -> erl_types:t_any(); redtest -> diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl index cf74c1eb5b..34b18acccd 100644 --- a/lib/hipe/icode/hipe_icode_range.erl +++ b/lib/hipe/icode/hipe_icode_range.erl @@ -1187,7 +1187,8 @@ basic_type(unsafe_tl) -> not_int; basic_type(#element{}) -> not_analysed; basic_type(#unsafe_element{}) -> not_analysed; basic_type(#unsafe_update_element{}) -> not_analysed; -basic_type(build_stacktrace) -> not_int. +basic_type(build_stacktrace) -> not_int; +basic_type(raw_raise) -> not_int. -spec analyse_bs_get_integer(integer(), integer(), boolean()) -> range_tuple(). diff --git a/lib/hipe/llvm/hipe_llvm.erl b/lib/hipe/llvm/hipe_llvm.erl index ccd40162cb..343ca94cb1 100644 --- a/lib/hipe/llvm/hipe_llvm.erl +++ b/lib/hipe/llvm/hipe_llvm.erl @@ -934,7 +934,7 @@ pp_ins(Dev, Ver, I) -> end, case call_is_tail(I) of true -> write(Dev, "tail "); - false -> ok + false -> write(Dev, "notail ") end, write(Dev, ["call ", call_cconv(I), " "]), pp_options(Dev, call_ret_attrs(I)), diff --git a/lib/hipe/rtl/hipe_rtl_primops.erl b/lib/hipe/rtl/hipe_rtl_primops.erl index d646b78a3d..ce5433379e 100644 --- a/lib/hipe/rtl/hipe_rtl_primops.erl +++ b/lib/hipe/rtl/hipe_rtl_primops.erl @@ -396,6 +396,8 @@ gen_primop({Op,Dst,Args,Cont,Fail}, IsGuard, ConstTab) -> [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)]; build_stacktrace -> [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)]; + raw_raise -> + [hipe_rtl:mk_call(Dst, Op, Args, Cont, Fail, not_remote)]; %% Only names listed above are accepted! MFA:s are not primops! _ -> diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl index d71b924d22..ba9c03d4ba 100644 --- a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl +++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl @@ -24,6 +24,7 @@ test() -> ok = test_bad_fun_call(), ok = test_guard_bif(), ok = test_eclectic(), + ok = test_raise(), ok. %%-------------------------------------------------------------------- @@ -579,3 +580,99 @@ my_add(A, B) -> my_abs(X) -> abs(X). + +test_raise() -> + test_raise(fun() -> exit({exit,tuple}) end), + test_raise(fun() -> abs(id(x)) end), + test_raise(fun() -> throw({was,thrown}) end), + + badarg = bad_raise(fun() -> abs(id(x)) end), + + ok. + +bad_raise(Expr) -> + try + Expr() + catch + _:E:Stk -> + erlang:raise(bad_class, E, Stk) + end. + +test_raise(Expr) -> + test_raise_1(Expr), + test_raise_2(Expr), + test_raise_3(Expr). + +test_raise_1(Expr) -> + erase(exception), + try + do_test_raise_1(Expr) + catch + C:E:Stk -> + {C,E,Stk} = erase(exception) + end. + +do_test_raise_1(Expr) -> + try + Expr() + catch + C:E:Stk -> + %% Here the stacktrace must be built. + put(exception, {C,E,Stk}), + erlang:raise(C, E, Stk) + end. + +test_raise_2(Expr) -> + erase(exception), + try + do_test_raise_2(Expr) + catch + C:E:Stk -> + {C,E} = erase(exception), + try + Expr() + catch + _:_:S -> + [StkTop|_] = S, + [StkTop|_] = Stk + end + end. + +do_test_raise_2(Expr) -> + try + Expr() + catch + C:E:Stk -> + %% Here it is possible to replace erlang:raise/3 with + %% the raw_raise/3 instruction since the stacktrace is + %% not actually used. + put(exception, {C,E}), + erlang:raise(C, E, Stk) + end. + +test_raise_3(Expr) -> + try + do_test_raise_3(Expr) + catch + exit:{exception,C,E}:Stk -> + try + Expr() + catch + C:E:S -> + [StkTop|_] = S, + [StkTop|_] = Stk + end + end. + +do_test_raise_3(Expr) -> + try + Expr() + catch + C:E:Stk -> + %% Here it is possible to replace erlang:raise/3 with + %% the raw_raise/3 instruction since the stacktrace is + %% not actually used. + erlang:raise(exit, {exception,C,E}, Stk) + end. + +id(I) -> I. diff --git a/lib/kernel/src/disk_log.erl b/lib/kernel/src/disk_log.erl index 70cbf1c87c..99ea8dc384 100644 --- a/lib/kernel/src/disk_log.erl +++ b/lib/kernel/src/disk_log.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -266,7 +266,7 @@ inc_wrap_file(Log) -> Size :: dlog_size(), Reason :: no_such_log | nonode | {read_only_mode, Log} | {blocked_log, Log} - | {new_size_too_small, CurrentSize :: pos_integer()} + | {new_size_too_small, Log, CurrentSize :: pos_integer()} | {badarg, size} | {file_error, file:filename(), file_error()}. change_size(Log, NewSize) -> diff --git a/lib/kernel/src/erl_boot_server.erl b/lib/kernel/src/erl_boot_server.erl index 2a38266579..4ac945ce01 100644 --- a/lib/kernel/src/erl_boot_server.erl +++ b/lib/kernel/src/erl_boot_server.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -58,13 +58,11 @@ -define(single_addr_mask, {255, 255, 255, 255}). --type ip4_address() :: {0..255,0..255,0..255,0..255}. - --spec start(Slaves) -> {'ok', Pid} | {'error', What} when +-spec start(Slaves) -> {'ok', Pid} | {'error', Reason} when Slaves :: [Host], - Host :: atom(), + Host :: inet:ip_address() | inet:hostname(), Pid :: pid(), - What :: any(). + Reason :: {'badarg', Slaves}. start(Slaves) -> case check_arg(Slaves) of @@ -74,11 +72,11 @@ start(Slaves) -> {error, {badarg, Slaves}} end. --spec start_link(Slaves) -> {'ok', Pid} | {'error', What} when +-spec start_link(Slaves) -> {'ok', Pid} | {'error', Reason} when Slaves :: [Host], - Host :: atom(), + Host :: inet:ip_address() | inet:hostname(), Pid :: pid(), - What :: any(). + Reason :: {'badarg', Slaves}. start_link(Slaves) -> case check_arg(Slaves) of @@ -104,10 +102,10 @@ check_arg([], Result) -> check_arg(_, _Result) -> error. --spec add_slave(Slave) -> 'ok' | {'error', What} when +-spec add_slave(Slave) -> 'ok' | {'error', Reason} when Slave :: Host, - Host :: atom(), - What :: any(). + Host :: inet:ip_address() | inet:hostname(), + Reason :: {'badarg', Slave}. add_slave(Slave) -> case inet:getaddr(Slave, inet) of @@ -117,10 +115,10 @@ add_slave(Slave) -> {error, {badarg, Slave}} end. --spec delete_slave(Slave) -> 'ok' | {'error', What} when +-spec delete_slave(Slave) -> 'ok' | {'error', Reason} when Slave :: Host, - Host :: atom(), - What :: any(). + Host :: inet:ip_address() | inet:hostname(), + Reason :: {'badarg', Slave}. delete_slave(Slave) -> case inet:getaddr(Slave, inet) of @@ -130,7 +128,7 @@ delete_slave(Slave) -> {error, {badarg, Slave}} end. --spec add_subnet(Mask :: ip4_address(), Addr :: ip4_address()) -> +-spec add_subnet(Netmask :: inet:ip_address(), Addr :: inet:ip_address()) -> 'ok' | {'error', any()}. add_subnet(Mask, Addr) when is_tuple(Mask), is_tuple(Addr) -> @@ -141,14 +139,15 @@ add_subnet(Mask, Addr) when is_tuple(Mask), is_tuple(Addr) -> {error, empty_subnet} end. --spec delete_subnet(Mask :: ip4_address(), Addr :: ip4_address()) -> 'ok'. +-spec delete_subnet(Netmask :: inet:ip_address(), + Addr :: inet:ip_address()) -> 'ok'. delete_subnet(Mask, Addr) when is_tuple(Mask), is_tuple(Addr) -> gen_server:call(boot_server, {delete, {Mask, Addr}}). -spec which_slaves() -> Slaves when - Slaves :: [Host], - Host :: atom(). + Slaves :: [Slave], + Slave :: {Netmask :: inet:ip_address(), Address :: inet:ip_address()}. which_slaves() -> gen_server:call(boot_server, which). diff --git a/lib/kernel/src/group_history.erl b/lib/kernel/src/group_history.erl index 91f3663cc5..9745848992 100644 --- a/lib/kernel/src/group_history.erl +++ b/lib/kernel/src/group_history.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2017. All Rights Reserved. +%% Copyright Ericsson AB 2017-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -260,7 +260,7 @@ resize_log(Name, _OldSize, NewSize) -> ok -> show('$#erlang-history-resize-result', "ok~n", []); - {error, {new_size_too_small, _}} -> + {error, {new_size_too_small, _, _}} -> show('$#erlang-history-resize-result', "failed (new size is too small)~n", []), disable_history(); diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index f4c7c277ed..f8199fcf71 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -236,9 +236,10 @@ load_common(Mod, Bin, Beam, Architecture) -> lists:foreach(fun({FE, DestAddress}) -> hipe_bifs:set_native_address_in_fe(FE, DestAddress) end, erase(closures_to_patch)), - ok = hipe_bifs:commit_patch_load(LoaderState), set_beam_call_traps(FunDefs), - ok; + export_funs(FunDefs), + ok = hipe_bifs:commit_patch_load(LoaderState), + ok; BeamBinary when is_binary(BeamBinary) -> %% Find all closures in the code. [] = erase(closures_to_patch), %Clean up, assertion. diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl index 7beaadb1d6..0709a6e766 100644 --- a/lib/kernel/test/disk_log_SUITE.erl +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2017. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. diff --git a/lib/kernel/test/global_SUITE.erl b/lib/kernel/test/global_SUITE.erl index 0a7f73c344..0e7b7adc47 100644 --- a/lib/kernel/test/global_SUITE.erl +++ b/lib/kernel/test/global_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2016. All Rights Reserved. +%% Copyright Ericsson AB 1997-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -3470,8 +3470,8 @@ start_procs(Parent, N1, N2, N3, Config) -> Pid6 = rpc:call(N3, ?MODULE, start_proc3, [test4]), assert_pid(Pid6), yes = global:register_name(test1, Pid3), - yes = global:register_name(test2, Pid4, {global, notify_all_name}), - yes = global:register_name(test3, Pid5, {global, random_notify_name}), + yes = global:register_name(test2, Pid4, fun global:notify_all_name/3), + yes = global:register_name(test3, Pid5, fun global:random_notify_name/3), Resolve = fun(Name, Pid1, Pid2) -> Parent ! {resolve_called, Name, node()}, {Min, Max} = minmax(Pid1, Pid2), @@ -3546,7 +3546,7 @@ start_proc_basic(Name) -> end. init_proc_basic(Parent, Name) -> - X = global:register_name(Name, self(), {?MODULE, fix_basic_name}), + X = global:register_name(Name, self(), fun ?MODULE:fix_basic_name/3), Parent ! {self(),X}, loop(). @@ -3791,15 +3791,6 @@ stop() -> test_server:stop_node(Node) end, nodes()). -dbg_logs(Name) -> dbg_logs(Name, ?NODES). - -dbg_logs(Name, Nodes) -> - lists:foreach(fun(N) -> - F = lists:concat([Name, ".log.", N, ".txt"]), - ok = sys:log_to_file({global_name_server, N}, F) - end, Nodes). - - %% Tests that locally loaded nodes do not loose contact with other nodes. global_lost_nodes(Config) when is_list(Config) -> Timeout = 60, diff --git a/lib/observer/src/observer_pro_wx.erl b/lib/observer/src/observer_pro_wx.erl index d612e0a1c5..1c40afba46 100644 --- a/lib/observer/src/observer_pro_wx.erl +++ b/lib/observer/src/observer_pro_wx.erl @@ -572,7 +572,8 @@ change_accum(true, S0) -> S0#holder{accum=true}; change_accum(false, S0=#holder{info=Info}) -> self() ! refresh, - S0#holder{accum=lists:sort(array:to_list(Info))}. + Accum = [{Pid, Reds} || #etop_proc_info{pid=Pid, reds=Reds} <- array:to_list(Info)], + S0#holder{accum=lists:sort(Accum)}. handle_update_old(#etop_info{procinfo=ProcInfo0}, S0=#holder{parent=Parent, sort=Sort=#sort{sort_key=KeyField}}) -> diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 4d3f306a0a..6b761cb2ff 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -257,8 +257,6 @@ init_stack_page(Parent, Pid) -> [Pid, current_stacktrace]) of {current_stacktrace,RawBt} -> - observer_wx:try_rpc(node(Pid), erlang, process_info, - [Pid, current_stacktrace]), wxListCtrl:deleteAllItems(LCtrl), wx:foldl(fun({M, F, A, Info}, Row) -> _Item = wxListCtrl:insertItem(LCtrl, Row, ""), diff --git a/lib/observer/src/observer_tv_wx.erl b/lib/observer/src/observer_tv_wx.erl index e16f3cab6b..2e387f7e74 100644 --- a/lib/observer/src/observer_tv_wx.erl +++ b/lib/observer/src/observer_tv_wx.erl @@ -38,13 +38,13 @@ -define(ID_SYSTEM_TABLES, 406). -define(ID_TABLE_INFO, 407). -define(ID_SHOW_TABLE, 408). - --record(opt, {type=ets, - sys_hidden=true, - unread_hidden=true, - sort_key=2, - sort_incr=true - }). + +-record(opts, {type=ets, + sys_hidden=true, + unread_hidden=true}). + +-record(sort, {sort_incr=true, + sort_key=2}). -record(state, { @@ -52,9 +52,9 @@ grid, panel, node=node(), - opt=#opt{}, + opts=#opts{}, + holder, selected, - tabs, timer }). @@ -64,8 +64,18 @@ start_link(Notebook, Parent, Config) -> init([Notebook, Parent, Config]) -> Panel = wxPanel:new(Notebook), Sizer = wxBoxSizer:new(?wxVERTICAL), - Style = ?wxLC_REPORT bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES, - Grid = wxListCtrl:new(Panel, [{winid, ?GRID}, {style, Style}]), + + Opts=#opts{type=maps:get(type, Config, ets), + sys_hidden=maps:get(sys_hidden, Config, true), + unread_hidden=maps:get(unread_hidden, Config, true)}, + + Style = ?wxLC_REPORT bor ?wxLC_VIRTUAL bor ?wxLC_SINGLE_SEL bor ?wxLC_HRULES, + Self = self(), + Attrs = observer_lib:create_attrs(), + Holder = spawn_link(fun() -> init_table_holder(Self, Attrs) end), + CBs = [{onGetItemText, fun(_, Item,Col) -> get_row(Holder, Item, Col) end}, + {onGetItemAttr, fun(_, Item) -> get_attr(Holder, Item) end}], + Grid = wxListCtrl:new(Panel, [{winid, ?GRID}, {style, Style} | CBs]), wxSizer:add(Sizer, Grid, [{flag, ?wxEXPAND bor ?wxALL}, {proportion, 1}, {border, 5}]), wxWindow:setSizer(Panel, Sizer), @@ -95,38 +105,26 @@ init([Notebook, Parent, Config]) -> wxWindow:setFocus(Grid), {Panel, #state{grid=Grid, parent=Parent, panel=Panel, - timer=Config, - opt=#opt{type=maps:get(type, Config, ets), - sys_hidden=maps:get(sys_hidden, Config, true), - unread_hidden=maps:get(unread_hidden, Config, true)} - }}. + opts=Opts, timer=Config, holder=Holder}}. handle_event(#wx{id=?ID_REFRESH}, - State = #state{node=Node, grid=Grid, opt=Opt}) -> - Tables = get_tables(Node, Opt), - {Tabs,Sel} = update_grid(Grid, sel(State), Opt, Tables), - Sel =/= undefined andalso wxListCtrl:ensureVisible(Grid, Sel), - {noreply, State#state{tabs=Tabs, selected=Sel}}; + State = #state{holder=Holder, node=Node, opts=Opts}) -> + Tables = get_tables(Node, Opts), + Holder ! {refresh, Tables}, + {noreply, State}; handle_event(#wx{event=#wxList{type=command_list_col_click, col=Col}}, - State = #state{node=Node, grid=Grid, - opt=Opt0=#opt{sort_key=Key, sort_incr=Bool}}) -> - Opt = case col2key(Col) of - Key -> Opt0#opt{sort_incr=not Bool}; - NewKey -> Opt0#opt{sort_key=NewKey} - end, - Tables = get_tables(Node, Opt), - {Tabs,Sel} = update_grid(Grid, sel(State), Opt, Tables), - wxWindow:setFocus(Grid), - {noreply, State#state{opt=Opt, tabs=Tabs, selected=Sel}}; + State = #state{holder=Holder}) -> + Holder ! {sort, Col}, + {noreply, State}; -handle_event(#wx{id=Id}, State = #state{node=Node, grid=Grid, opt=Opt0}) +handle_event(#wx{id=Id}, State = #state{node=Node, holder=Holder, grid=Grid, opts=Opt0}) when Id >= ?ID_ETS, Id =< ?ID_SYSTEM_TABLES -> Opt = case Id of - ?ID_ETS -> Opt0#opt{type=ets}; - ?ID_MNESIA -> Opt0#opt{type=mnesia}; - ?ID_UNREADABLE -> Opt0#opt{unread_hidden= not Opt0#opt.unread_hidden}; - ?ID_SYSTEM_TABLES -> Opt0#opt{sys_hidden= not Opt0#opt.sys_hidden} + ?ID_ETS -> Opt0#opts{type=ets}; + ?ID_MNESIA -> Opt0#opts{type=mnesia}; + ?ID_UNREADABLE -> Opt0#opts{unread_hidden= not Opt0#opts.unread_hidden}; + ?ID_SYSTEM_TABLES -> Opt0#opts{sys_hidden= not Opt0#opts.sys_hidden} end, case get_tables2(Node, Opt) of Error = {error, _} -> @@ -135,9 +133,9 @@ handle_event(#wx{id=Id}, State = #state{node=Node, grid=Grid, opt=Opt0}) self() ! Error, {noreply, State}; Tables -> - {Tabs, Sel} = update_grid(Grid, sel(State), Opt, Tables), + Holder ! {refresh, Tables}, wxWindow:setFocus(Grid), - {noreply, State#state{opt=Opt, tabs=Tabs, selected=Sel}} + {noreply, State#state{opts=Opt}} end; handle_event(#wx{event=#wxSize{size={W,_}}}, State=#state{grid=Grid}) -> @@ -146,19 +144,18 @@ handle_event(#wx{event=#wxSize{size={W,_}}}, State=#state{grid=Grid}) -> handle_event(#wx{event=#wxList{type=command_list_item_activated, itemIndex=Index}}, - State=#state{grid=Grid, node=Node, opt=#opt{type=Type}, tabs=Tabs}) -> - Table = lists:nth(Index+1, Tabs), - case Table#tab.protection of - private -> - self() ! {error, "Table has 'private' protection and can not be read"}; - _ -> - observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]) + State=#state{holder=Holder, node=Node, opts=#opts{type=Type}, grid=Grid}) -> + case get_table(Holder, Index) of + #tab{protection=private} -> + self() ! {error, "Table has 'private' protection and can not be read"}; + #tab{}=Table -> + observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]); + _ -> ignore end, {noreply, State}; handle_event(#wx{event=#wxList{type=command_list_item_right_click}}, State=#state{panel=Panel}) -> - Menu = wxMenu:new(), wxMenu:append(Menu, ?ID_TABLE_INFO, "Table info"), wxMenu:append(Menu, ?ID_SHOW_TABLE, "Show Table Content"), @@ -167,32 +164,33 @@ handle_event(#wx{event=#wxList{type=command_list_item_right_click}}, {noreply, State}; handle_event(#wx{event=#wxList{type=command_list_item_selected, itemIndex=Index}}, - State) -> + State=#state{holder=Holder}) -> + Holder ! {selected, Index}, {noreply, State#state{selected=Index}}; handle_event(#wx{id=?ID_TABLE_INFO}, - State = #state{grid=Grid, node=Node, opt=#opt{type=Type}, tabs=Tabs, selected=Sel}) -> + State = #state{holder=Holder, grid=Grid, node=Node, opts=#opts{type=Type}, selected=Sel}) -> case Sel of undefined -> {noreply, State}; R when is_integer(R) -> - Table = lists:nth(Sel+1, Tabs), + Table = get_table(Holder, Sel), display_table_info(Grid, Node, Type, Table), {noreply, State} end; handle_event(#wx{id=?ID_SHOW_TABLE}, - State=#state{grid=Grid, node=Node, opt=#opt{type=Type}, tabs=Tabs, selected=Sel}) -> + State=#state{holder=Holder, grid=Grid, node=Node, opts=#opts{type=Type}, selected=Sel}) -> case Sel of undefined -> {noreply, State}; R when is_integer(R) -> - Table = lists:nth(Sel+1, Tabs), - case Table#tab.protection of - private -> + case get_table(Holder, R) of + #tab{protection=private} -> self() ! {error, "Table has 'private' protection and can not be read"}; - _ -> - observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]) + #tab{}=Table -> + observer_tv_table:start_link(Grid, [{node,Node}, {type,Type}, {table,Table}]); + _ -> ignore end, {noreply, State} end; @@ -202,14 +200,14 @@ handle_event(#wx{id=?ID_REFRESH_INTERVAL}, Timer = observer_lib:interval_dialog(Grid, Timer0, 10, 5*60), {noreply, State#state{timer=Timer}}; -handle_event(Event, _State) -> - error({unhandled_event, Event}). +handle_event(_Event, State) -> + {noreply, State}. handle_sync_event(_Event, _Obj, _State) -> ok. -handle_call(get_config, _, #state{timer=Timer, opt=Opt}=State) -> - #opt{type=Type, sys_hidden=Sys, unread_hidden=Unread} = Opt, +handle_call(get_config, _, #state{timer=Timer, opts=Opt}=State) -> + #opts{type=Type, sys_hidden=Sys, unread_hidden=Unread} = Opt, Conf0 = observer_lib:timer_config(Timer), Conf = Conf0#{type=>Type, sys_hidden=>Sys, unread_hidden=>Unread}, {reply, Conf, State}; @@ -220,50 +218,68 @@ handle_call(Event, From, _State) -> handle_cast(Event, _State) -> error({unhandled_cast, Event}). -handle_info(refresh_interval, State = #state{node=Node, grid=Grid, opt=Opt, - tabs=OldTabs}) -> - case get_tables(Node, Opt) of - OldTabs -> - %% no change - {noreply, State}; - Tables -> - {Tabs, Sel} = update_grid(Grid, sel(State), Opt, Tables), - Sel =/= undefined andalso wxListCtrl:ensureVisible(Grid, Sel), - {noreply, State#state{tabs=Tabs, selected=Sel}} - end; +handle_info(refresh_interval, State = #state{holder=Holder, node=Node, opts=Opt}) -> + Tables = get_tables(Node, Opt), + Holder ! {refresh, Tables}, + {noreply, State}; -handle_info({active, Node}, State = #state{parent=Parent, grid=Grid, opt=Opt0, - timer=Timer0}) -> - {Tables, Opt} = case Opt0#opt.type =:= mnesia andalso get_tables2(Node, Opt0) of +handle_info({active, Node}, State = #state{parent=Parent, holder=Holder, grid=Grid, + opts=Opt0, timer=Timer0}) -> + {Tables, Opt} = case Opt0#opts.type =:= mnesia andalso get_tables2(Node, Opt0) of Ts when is_list(Ts) -> {Ts, Opt0}; _ -> % false or error getting mnesia tables - Opt1 = Opt0#opt{type=ets}, + Opt1 = Opt0#opts{type=ets}, {get_tables(Node, Opt1), Opt1} end, - {Tabs,Sel} = update_grid(Grid, sel(State), Opt, Tables), + Holder ! {refresh, Tables}, wxWindow:setFocus(Grid), create_menus(Parent, Opt), Timer = observer_lib:start_timer(Timer0, 10), - {noreply, State#state{node=Node, tabs=Tabs, timer=Timer, opt=Opt, selected=Sel}}; + {noreply, State#state{node=Node, timer=Timer, opts=Opt}}; handle_info(not_active, State = #state{timer = Timer0}) -> Timer = observer_lib:stop_timer(Timer0), {noreply, State#state{timer=Timer}}; -handle_info({error, Error}, #state{panel=Panel,opt=Opt}=State) -> +handle_info({error, Error}, #state{panel=Panel,opts=Opt}=State) -> Str = io_lib:format("ERROR: ~ts~n",[Error]), observer_lib:display_info_dialog(Panel,Str), - case Opt#opt.type of + case Opt#opts.type of mnesia -> wxMenuBar:check(observer_wx:get_menubar(), ?ID_ETS, true); _ -> ok end, - {noreply, State#state{opt=Opt#opt{type=ets}}}; + {noreply, State#state{opts=Opt#opts{type=ets}}}; + +handle_info({refresh, Min, Min}, State = #state{grid=Grid}) -> + wxListCtrl:setItemCount(Grid, Min+1), + wxListCtrl:refreshItem(Grid, Min), %% Avoid assert in wx below if Max is 0 + observer_wx:set_status(io_lib:format("Tables: ~w", [Min+1])), + {noreply, State}; +handle_info({refresh, Min, Max}, State = #state{grid=Grid}) -> + wxListCtrl:setItemCount(Grid, Max+1), + Max > 0 andalso wxListCtrl:refreshItems(Grid, Min, Max), + observer_wx:set_status(io_lib:format("Tables: ~w", [Max+1])), + {noreply, State}; + +handle_info({selected, New, Size}, #state{grid=Grid, selected=Old} = State) -> + if + is_integer(Old), Old < Size -> + wxListCtrl:setItemState(Grid, Old, 0, ?wxLIST_STATE_SELECTED); + true -> ignore + end, + if is_integer(New) -> + wxListCtrl:setItemState(Grid, New, 16#FFFF, ?wxLIST_STATE_SELECTED), + wxListCtrl:ensureVisible(Grid, New); + true -> ignore + end, + {noreply, State#state{selected=New}}; handle_info(_Event, State) -> {noreply, State}. -terminate(_Event, _State) -> +terminate(_Event, #state{holder=Holder}) -> + Holder ! stop, ok. code_change(_, _, State) -> @@ -271,7 +287,7 @@ code_change(_, _, State) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -create_menus(Parent, #opt{sys_hidden=Sys, unread_hidden=UnR, type=Type}) -> +create_menus(Parent, #opts{sys_hidden=Sys, unread_hidden=UnR, type=Type}) -> MenuEntries = [{"View", [#create_menu{id = ?ID_TABLE_INFO, text = "Table information\tCtrl-I"}, separator, @@ -298,7 +314,7 @@ get_tables(Node, Opts) -> Res -> Res end. -get_tables2(Node, #opt{type=Type, sys_hidden=Sys, unread_hidden=Unread}) -> +get_tables2(Node, #opts{type=Type, sys_hidden=Sys, unread_hidden=Unread}) -> Args = [Type, [{sys_hidden,Sys}, {unread_hidden,Unread}]], case rpc:call(Node, observer_backend, get_table_list, Args) of {badrpc, Error} -> @@ -386,49 +402,134 @@ list_to_strings([A]) -> integer_to_list(A); list_to_strings([A|B]) -> integer_to_list(A) ++ " ," ++ list_to_strings(B). -update_grid(Grid, Selected, Opt, Tables) -> - wx:batch(fun() -> update_grid2(Grid, Selected, Opt, Tables) end). - -update_grid2(Grid, {SelName,SelId}, #opt{sort_key=Sort,sort_incr=Dir}, Tables) -> - wxListCtrl:deleteAllItems(Grid), - Update = - fun(#tab{name = Name, id = Id, owner = Owner, size = Size, memory = Memory, - protection = Protection, reg_name = RegName}, - {Row, Sel}) -> - _Item = wxListCtrl:insertItem(Grid, Row, ""), - if (Row rem 2) =:= 0 -> - wxListCtrl:setItemBackgroundColour(Grid, Row, ?BG_EVEN); - true -> ignore - end, - if Protection == private -> - wxListCtrl:setItemTextColour(Grid, Row, {200,130,50}); - true -> ignore - end, - - lists:foreach(fun({_, ignore}) -> ignore; - ({Col, Val}) -> - wxListCtrl:setItem(Grid, Row, Col, observer_lib:to_str(Val)) - end, - [{0,Name}, {1,Size}, {2, Memory div 1024}, - {3,Owner}, {4,RegName}, {5,Id}]), - if SelName =:= Name, SelId =:= Id -> - wxListCtrl:setItemState(Grid, Row, 16#FFFF, ?wxLIST_STATE_SELECTED), - {Row+1, Row}; - true -> - wxListCtrl:setItemState(Grid, Row, 0, ?wxLIST_STATE_SELECTED), - {Row+1, Sel} - end - end, - ProcInfo = case Dir of - false -> lists:reverse(lists:keysort(Sort, Tables)); - true -> lists:keysort(Sort, Tables) - end, - {_, Sel} = lists:foldl(Update, {0, undefined}, ProcInfo), - {ProcInfo, Sel}. - -sel(#state{selected=Sel, tabs=Tabs}) -> - try lists:nth(Sel+1, Tabs) of - #tab{name=Name, id=Id} -> {Name, Id} - catch _:_ -> - {undefined, undefined} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Table holder needs to be in a separate process otherwise +%% the callback get_row/3 may deadlock if the process do +%% wx calls when callback is invoked. + +get_table(Table, Item) -> + get_row(Table, Item, all). + +get_row(Table, Item, Column) -> + Ref = erlang:monitor(process, Table), + Table ! {get_row, self(), Item, Column}, + receive + {'DOWN', Ref, _, _, _} -> ""; + {Table, Res} -> + erlang:demonitor(Ref), + Res end. + +get_attr(Table, Item) -> + Ref = erlang:monitor(process, Table), + Table ! {get_attr, self(), Item}, + receive + {'DOWN', Ref, _, _, _} -> wx:null(); + {Table, Res} -> + erlang:demonitor(Ref), + Res + end. + +-record(holder, {node, parent, pid, + tabs=array:new(), + sort=#sort{}, + attrs, + sel + }). + +init_table_holder(Parent, Attrs) -> + Parent ! refresh, + table_holder(#holder{node=node(), parent=Parent, attrs=Attrs}). + +table_holder(S0 = #holder{parent=Parent, tabs=Tabs0, sel=Sel0}) -> + receive + {get_attr, From, Row} -> + get_attr(From, Row, S0), + table_holder(S0); + {get_row, From, Row, Col} -> + get_row(From, Row, Col, Tabs0), + table_holder(S0); + {sort, Col} -> + STab = get_sel(Sel0, Tabs0), + Parent ! {refresh, 0, array:size(Tabs0)-1}, + S1 = sort(col2key(Col), S0), + Sel = sel_idx(STab, S1#holder.tabs), + Parent ! {selected, Sel, array:size(Tabs0)}, + table_holder(S1#holder{sel=Sel}); + {refresh, Tabs1} -> + STab = get_sel(Sel0, Tabs0), + Tabs = case S0#holder.sort of + #sort{sort_incr=false, sort_key=Col} -> + array:from_list(lists:reverse(lists:keysort(Col, Tabs1))); + #sort{sort_key=Col} -> + array:from_list(lists:keysort(Col, Tabs1)) + end, + Parent ! {refresh, 0, array:size(Tabs)-1}, + Sel = sel_idx(STab, Tabs), + Parent ! {selected, Sel,array:size(Tabs)}, + table_holder(S0#holder{tabs=Tabs, sel=Sel}); + {selected, Sel} -> + table_holder(S0#holder{sel=Sel}); + stop -> + ok; + What -> + io:format("Table holder got ~tp~n",[What]), + Parent ! {refresh, 0, array:size(Tabs0)-1}, + table_holder(S0) + end. + +get_sel(undefined, _Tabs) -> + undefined; +get_sel(Idx, Tabs) -> + array:get(Idx, Tabs). + +sel_idx(undefined, _Tabs) -> + undefined; +sel_idx(Tab, Tabs) -> + Find = fun(Idx, C, Acc) -> C =:= Tab andalso throw({found, Idx}), Acc end, + try array:foldl(Find, undefined, Tabs) + catch {found, Idx} -> Idx + end. + +sort(Col, #holder{sort=#sort{sort_key=Col, sort_incr=Incr}=S, tabs=Table0}=H) -> + Table = lists:reverse(array:to_list(Table0)), + H#holder{sort=S#sort{sort_incr=(not Incr)}, + tabs=array:from_list(Table)}; +sort(Col, #holder{sort=#sort{sort_incr=Incr}=S, tabs=Table0}=H) -> + Table = case Incr of + false -> lists:reverse(lists:keysort(Col, array:to_list(Table0))); + true -> lists:keysort(Col, array:to_list(Table0)) + end, + H#holder{sort=S#sort{sort_key=Col}, + tabs=array:from_list(Table)}. + +get_row(From, Row, Col, Table) -> + Object = array:get(Row, Table), + From ! {self(), get_col(Col, Object)}. + +get_col(all, Rec) -> + Rec; +get_col(2, #tab{}=Rec) -> %% Memory in kB + observer_lib:to_str(element(#tab.memory, Rec) div 1024); +get_col(Col, #tab{}=Rec) -> + case element(col2key(Col), Rec) of + ignore -> ""; + Val -> observer_lib:to_str(Val) + end; +get_col(_, _) -> + "". + +get_attr(From, Row, #holder{tabs=Tabs, attrs=Attrs}) -> + EvenOdd = case (Row rem 2) > 0 of + true -> Attrs#attrs.odd; + false -> Attrs#attrs.even + end, + What = try array:get(Row, Tabs) of + #tab{protection=private} -> + Attrs#attrs.deleted; + _ -> + EvenOdd + catch _ -> + EvenOdd + end, + From ! {self(), What}. diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl index 0db2c1ea77..fd4f93f662 100644 --- a/lib/observer/test/observer_SUITE.erl +++ b/lib/observer/test/observer_SUITE.erl @@ -113,7 +113,12 @@ appup_file(Config) when is_list(Config) -> basic(suite) -> []; basic(doc) -> [""]; basic(Config) when is_list(Config) -> - timer:send_after(100, "foobar"), %% Otherwise the timer server gets added to procs + %% Start these before + wx:new(), + wx:destroy(), + timer:send_after(100, "foobar"), + {foo, node@machine} ! dummy_msg, %% start distribution stuff + %% Otherwise ever lasting servers gets added to procs ProcsBefore = processes(), ProcInfoBefore = [{P,process_info(P)} || P <- ProcsBefore], NumProcsBefore = length(ProcsBefore), diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 8fcda78ed5..80b639155b 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -32,7 +32,7 @@ <modulesummary>Interface Functions for Secure Socket Layer</modulesummary> <description> <p> - This module contains interface functions for the SSL/TLS protocol. + This module contains interface functions for the SSL/TLS/DTLS protocol. For detailed information about the supported standards see <seealso marker="ssl_app">ssl(6)</seealso>. </p> @@ -40,7 +40,7 @@ <section> <title>DATA TYPES</title> - <p>The following data types are used in the functions for SSL:</p> + <p>The following data types are used in the functions for SSL/TLS/DTLS:</p> <taglist> @@ -56,9 +56,11 @@ <p>The default socket options are <c>[{mode,list},{packet, 0},{header, 0},{active, true}]</c>.</p> <p>For valid options, see the - <seealso marker="kernel:inet">inet(3)</seealso> and - <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso> manual pages - in Kernel.</p></item> + <seealso marker="kernel:inet">inet(3)</seealso>, + <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso> and + <seealso marker="kernel:gen_tcp">gen_udp(3)</seealso> + manual pages + in Kernel. Note that stream oriented options such as packet are only relevant for SSL/TLS and not DTLS</p></item> <tag><marker id="type-ssloption"/><c>ssl_option() =</c></tag> <item> @@ -95,13 +97,14 @@ <item><p><c>{cb_info, {CallbackModule::atom(), DataTag::atom(), ClosedTag::atom(), ErrTag:atom()}}</c></p> - <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error}</c>. Can be used - to customize the transport layer. The callback module must implement a + <p>Defaults to <c>{gen_tcp, tcp, tcp_closed, tcp_error}</c> for TLS + and <c>{gen_udp, udp, udp_closed, udp_error}</c> for DTLS. Can be used + to customize the transport layer. For TLS the callback module must implement a reliable transport protocol, behave as <c>gen_tcp</c>, and have functions corresponding to <c>inet:setopts/2</c>, <c>inet:getopts/2</c>, <c>inet:peername/1</c>, <c>inet:sockname/1</c>, and <c>inet:port/1</c>. The callback <c>gen_tcp</c> is treated specially and calls <c>inet</c> - directly.</p> + directly. For DTLS this feature must be considered exprimental.</p> <taglist> <tag><c>CallbackModule =</c></tag> <item><p><c>atom()</c></p></item> @@ -137,10 +140,16 @@ <tag><c>sslsocket() =</c></tag> <item><p>opaque()</p></item> - - <tag><marker id="type-protocol"/><c>protocol() =</c></tag> + + <tag><marker id="type-protocol"/><c> protocol_versions() =</c></tag> + <item><p><c> ssl_tls_protocol() | dtls_protocol() </c></p></item> + + <tag><marker id="type-protocol"/><c> ssl_tls_protocol() =</c></tag> <item><p><c>sslv3 | tlsv1 | 'tlsv1.1' | 'tlsv1.2'</c></p></item> + <tag><marker id="type-protocol"/><c> dtls_protocol() =</c></tag> + <item><p><c>'dtlsv1' | 'dtlsv1.2'</c></p></item> + <tag><c>ciphers() =</c></tag> <item><p><c>= [ciphersuite()] | string()</c></p> <p>According to old API.</p></item> @@ -184,7 +193,7 @@ </section> <section> - <title>SSL OPTION DESCRIPTIONS - COMMON for SERVER and CLIENT</title> + <title>TLS/DTLS OPTION DESCRIPTIONS - COMMON for SERVER and CLIENT</title> <p>The following options have the same meaning in the client and the server:</p> @@ -289,11 +298,11 @@ atom()}} | <list type="bulleted"> <item><p>If the verify callback fun returns <c>{fail, Reason}</c>, the verification process is immediately stopped, an alert is - sent to the peer, and the TLS/SSL handshake terminates.</p></item> + sent to the peer, and the TLS/DTLS handshake terminates.</p></item> <item><p>If the verify callback fun returns <c>{valid, UserState}</c>, the verification process continues.</p></item> <item><p>If the verify callback fun always returns - <c>{valid, UserState}</c>, the TLS/SSL handshake does not + <c>{valid, UserState}</c>, the TLS/DTLS handshake does not terminate regarding verification failures and the connection is established.</p></item> <item><p>If called with an extension unknown to the user application, @@ -456,15 +465,15 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_validation/3</seealso> with the selected CA as trusted anchor and the rest of the chain.</p></item> - <tag><c>{versions, [protocol()]}</c></tag> + <tag><c>{versions, [protocol_versions()]}</c></tag> <item><p>TLS protocol versions supported by started clients and servers. This option overrides the application environment option - <c>protocol_version</c>. If the environment option is not set, it defaults + <c>protocol_version</c> and <c>dtls_protocol_version</c>. If the environment option is not set, it defaults to all versions, except SSL-3.0, supported by the SSL application. See also <seealso marker="ssl:ssl_app">ssl(6).</seealso></p></item> <tag><c>{hibernate_after, integer()|undefined}</c></tag> - <item><p>When an integer-value is specified, <c>ssl_connection</c> + <item><p>When an integer-value is specified, <c>TLS/DTLS-connection</c> goes into hibernation after the specified number of milliseconds of inactivity, thus reducing its memory footprint. When <c>undefined</c> is specified (this is the default), the process @@ -524,7 +533,7 @@ fun(srp, Username :: string(), UserState :: term()) -> </section> <section> - <title>SSL OPTION DESCRIPTIONS - CLIENT SIDE</title> + <title>TLS/DTLS OPTION DESCRIPTIONS - CLIENT SIDE</title> <p>The following options are client-specific or have a slightly different meaning in the client than in the server:</p> @@ -664,7 +673,7 @@ fun(srp, Username :: string(), UserState :: term()) -> </section> <section> - <title>SSL OPTION DESCRIPTIONS - SERVER SIDE</title> + <title>TLS/DTLS OPTION DESCRIPTIONS - SERVER SIDE</title> <p>The following options are server-specific or have a slightly different meaning in the server than in the client:</p> @@ -702,7 +711,7 @@ fun(srp, Username :: string(), UserState :: term()) -> </p></item> <tag><c>{fail_if_no_peer_cert, boolean()}</c></tag> - <item><p>Used together with <c>{verify, verify_peer}</c> by an SSL server. + <item><p>Used together with <c>{verify, verify_peer}</c> by an TLS/DTLS server. If set to <c>true</c>, the server fails if the client does not have a certificate to send, that is, sends an empty certificate. If set to <c>false</c>, it fails only if the client sends an invalid @@ -716,7 +725,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <tag><c>{reuse_session, fun(SuggestedSessionId, PeerCert, Compression, CipherSuite) -> boolean()}</c></tag> - <item><p>Enables the SSL server to have a local policy + <item><p>Enables the TLS/DTLS server to have a local policy for deciding if a session is to be reused or not. Meaningful only if <c>reuse_sessions</c> is set to <c>true</c>. <c>SuggestedSessionId</c> is a <c>binary()</c>, <c>PeerCert</c> is @@ -814,7 +823,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <section> <title>General</title> - <p>When an SSL socket is in active mode (the default), data from the + <p>When an TLS/DTLS socket is in active mode (the default), data from the socket is delivered to the owner of the socket in the form of messages:</p> @@ -832,6 +841,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>cipher_suites() -></name> <name>cipher_suites(Type) -> ciphers()</name> + <name>cipher_suites(Type, protocol_version()) -> ciphers()</name> <fsummary>Returns a list of supported cipher suites.</fsummary> <type> <v>Type = erlang | openssl | all</v> @@ -843,13 +853,14 @@ fun(srp, Username :: string(), UserState :: term()) -> all available cipher suites. The cipher suites not present in <c>cipher_suites(erlang)</c> but included in <c>cipher_suites(all)</c> are not used unless explicitly configured - by the user.</p> + by the user. If the version option is not specified, the highest supported + TLS version will be used to determine the supported cipher suites</p> </desc> </func> <func> <name>eccs() -></name> - <name>eccs(protocol()) -> [named_curve()]</name> + <name>eccs(protocol_version()) -> [named_curve()]</name> <fsummary>Returns a list of supported ECCs.</fsummary> <desc><p>Returns a list of supported ECCs. <c>eccs()</c> @@ -857,7 +868,7 @@ fun(srp, Username :: string(), UserState :: term()) -> supported protocols and then deduplicating the output.</p> </desc> </func> - + <func> <name>clear_pem_cache() -> ok </name> <fsummary> Clears the pem cache</fsummary> @@ -872,20 +883,20 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>connect(Socket, SslOptions) -> </name> - <name>connect(Socket, SslOptions, Timeout) -> {ok, SslSocket} + <name>connect(Socket, SslOptions, Timeout) -> {ok, TLSSocket} | {error, Reason}</name> <fsummary>Upgrades a <c>gen_tcp</c>, or - equivalent, connected socket to an SSL socket.</fsummary> + equivalent, connected socket to an TLS socket.</fsummary> <type> <v>Socket = socket()</v> <v>SslOptions = [ssl_option()]</v> <v>Timeout = integer() | infinity</v> - <v>SslSocket = sslsocket()</v> + <v>TLSSocket = sslsocket()</v> <v>Reason = term()</v> </type> <desc><p>Upgrades a <c>gen_tcp</c>, or equivalent, - connected socket to an SSL socket, that is, performs the - client-side ssl handshake.</p> + connected socket to an TLS socket, that is, performs the + client-side TLS handshake.</p> <note><p>If the option <c>verify</c> is set to <c>verify_peer</c> the option <c>server_name_indication</c> shall also be specified, @@ -899,7 +910,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <name>connect(Host, Port, Options) -></name> <name>connect(Host, Port, Options, Timeout) -> {ok, SslSocket} | {error, Reason}</name> - <fsummary>Opens an SSL connection to <c>Host</c>, <c>Port</c>.</fsummary> + <fsummary>Opens an TLS/DTLS connection to <c>Host</c>, <c>Port</c>.</fsummary> <type> <v>Host = host()</v> <v>Port = integer()</v> @@ -908,13 +919,13 @@ fun(srp, Username :: string(), UserState :: term()) -> <v>SslSocket = sslsocket()</v> <v>Reason = term()</v> </type> - <desc><p>Opens an SSL connection to <c>Host</c>, <c>Port</c>.</p> + <desc><p>Opens an TLS/DTLS connection to <c>Host</c>, <c>Port</c>.</p> <p> When the option <c>verify</c> is set to <c>verify_peer</c> the check <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso> will be performed in addition to the usual x509-path validation checks. If the check fails the error {bad_cert, hostname_check_failed} will be propagated to the path validation fun <seealso marker="#verify_fun">verify_fun</seealso>, where it is possible to do customized - checks by using the full possibilitis of the <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso> API. + checks by using the full possibilities of the <seealso marker="public_key:public_key#pkix_verify_hostname-3">public_key:pkix_verify_hostname/3</seealso> API. When the option <c>server_name_indication</c> is provided, its value (the DNS name) will be used as <c>ReferenceID</c> to <seealso marker="public_key:public_key#pkix_verify_hostname-2">public_key:pkix_verify_hostname/2</seealso>. @@ -930,24 +941,24 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>close(SslSocket) -> ok | {error, Reason}</name> - <fsummary>Closes an SSL connection.</fsummary> + <fsummary>Closes an TLS/DTLS connection.</fsummary> <type> <v>SslSocket = sslsocket()</v> <v>Reason = term()</v> </type> - <desc><p>Closes an SSL connection.</p> + <desc><p>Closes an TLS/DTLS connection.</p> </desc> </func> <func> <name>close(SslSocket, How) -> ok | {ok, port()} | {error, Reason}</name> - <fsummary>Closes an SSL connection.</fsummary> + <fsummary>Closes an TLS connection.</fsummary> <type> <v>SslSocket = sslsocket()</v> <v>How = timeout() | {NewController::pid(), timeout()} </v> <v>Reason = term()</v> </type> - <desc><p>Closes or downgrades an SSL connection. In the latter case the transport + <desc><p>Closes or downgrades an TLS connection. In the latter case the transport connection will be handed over to the <c>NewController</c> process after receiving the TLS close alert from the peer. The returned transport socket will have the following options set: <c>[{active, false}, {packet, 0}, {mode, binary}]</c></p> @@ -958,7 +969,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <name>controlling_process(SslSocket, NewOwner) -> ok | {error, Reason}</name> <fsummary>Assigns a new controlling process to the - SSL socket.</fsummary> + TLS/DTLS socket.</fsummary> <type> <v>SslSocket = sslsocket()</v> <v>NewOwner = pid()</v> @@ -1121,7 +1132,7 @@ fun(srp, Username :: string(), UserState :: term()) -> extra key material. It either takes user-generated values for <c>Secret</c> and <c>Seed</c> or atoms directing it to use a specific value from the session security parameters.</p> - <p>Can only be used with TLS connections; <c>{error, undefined}</c> + <p>Can only be used with TLS/DTLS connections; <c>{error, undefined}</c> is returned for SSLv3 connections.</p> </desc> </func> @@ -1221,7 +1232,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <v>Reason = term()</v> </type> <desc> - <p>Performs the SSL/TLS server-side handshake.</p> + <p>Performs the SSL/TLS/DTLS server-side handshake.</p> <p><c>Socket</c> is a socket as returned by <seealso marker="#transport_accept-2">ssl:transport_accept/[1,2]</seealso> </p> @@ -1231,7 +1242,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <func> <name>ssl_accept(Socket, SslOptions) -> </name> <name>ssl_accept(Socket, SslOptions, Timeout) -> {ok, Socket} | ok | {error, Reason}</name> - <fsummary>Performs server-side SSL/TLS handshake.</fsummary> + <fsummary>Performs server-side SSL/TLS/DTLS handshake.</fsummary> <type> <v>Socket = socket() | sslsocket() </v> <v>SslOptions = [ssl_option()]</v> @@ -1248,10 +1259,10 @@ fun(srp, Username :: string(), UserState :: term()) -> by calling this function, else the upgrade succeeds or does not succeed depending on timing.</p></warning> - <p>If <c>Socket</c> is an <c>sslsocket()</c>: provides extra SSL/TLS + <p>If <c>Socket</c> is an <c>sslsocket()</c>: provides extra SSL/TLS/DTLS options to those specified in <seealso marker="#listen-2">ssl:listen/2 </seealso> and then performs - the SSL/TLS handshake. + the SSL/TLS/DTLS handshake. </p> </desc> </func> @@ -1310,7 +1321,7 @@ fun(srp, Username :: string(), UserState :: term()) -> The socket returned is to be passed to <seealso marker="#ssl_accept-2"> ssl:ssl_accept[2,3]</seealso> to complete handshaking, that is, - establishing the SSL/TLS connection.</p> + establishing the SSL/TLS/DTLS connection.</p> <warning> <p>The socket returned can only be used with <seealso marker="#ssl_accept-2"> ssl:ssl_accept[2,3]</seealso>. @@ -1332,7 +1343,8 @@ fun(srp, Username :: string(), UserState :: term()) -> <fsummary>Returns version information relevant for the SSL application.</fsummary> <type> - <v>versions_info() = {app_vsn, string()} | {supported | available, [protocol()] </v> + <v>versions_info() = {app_vsn, string()} | {supported | available, [ssl_tls_protocol()]} | + {supported_dtls | available_dtls, [dtls_protocol()]} </v> </type> <desc> <p>Returns version information relevant for the SSL @@ -1342,19 +1354,35 @@ fun(srp, Username :: string(), UserState :: term()) -> <item>The application version of the SSL application.</item> <tag><c>supported</c></tag> - <item>TLS/SSL versions supported by default. + <item>SSL/TLS versions supported by default. Overridden by a version option on <seealso marker="#connect-2"> connect/[2,3,4]</seealso>, <seealso marker="#listen-2"> listen/2</seealso>, and <seealso marker="#ssl_accept-2">ssl_accept/[1,2,3]</seealso>. - For the negotiated TLS/SSL version, see <seealso + For the negotiated SSL/TLS version, see <seealso marker="#connection_information-1">ssl:connection_information/1 </seealso>.</item> - + + <tag><c>supported_dtls</c></tag> + <item>DTLS versions supported by default. + Overridden by a version option on + <seealso marker="#connect-2"> connect/[2,3,4]</seealso>, + <seealso marker="#listen-2"> listen/2</seealso>, and <seealso + marker="#ssl_accept-2">ssl_accept/[1,2,3]</seealso>. + For the negotiated DTLS version, see <seealso + marker="#connection_information-1">ssl:connection_information/1 + </seealso>.</item> + <tag><c>available</c></tag> - <item>All TLS/SSL versions supported by the SSL application. + <item>All SSL/TLS versions supported by the SSL application. TLS 1.2 requires sufficient support from the Crypto application.</item> + + <tag><c>available_dtls</c></tag> + <item>All DTLS versions supported by the SSL application. + DTLS 1.2 requires sufficient support from the Crypto + application.</item> + </taglist> </desc> </func> @@ -1365,6 +1393,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <title>SEE ALSO</title> <p><seealso marker="kernel:inet">inet(3)</seealso> and <seealso marker="kernel:gen_tcp">gen_tcp(3)</seealso> + <seealso marker="kernel:gen_udp">gen_udp(3)</seealso> </p> </section> diff --git a/lib/ssl/doc/src/ssl_app.xml b/lib/ssl/doc/src/ssl_app.xml index e4109dd080..51070bb083 100644 --- a/lib/ssl/doc/src/ssl_app.xml +++ b/lib/ssl/doc/src/ssl_app.xml @@ -35,11 +35,11 @@ <description> <p> - The ssl application is an implementation of the SSL/TLS protocol in Erlang. + The ssl application is an implementation of the SSL/TLS/DTLS protocol in Erlang. </p> <list type="bulleted"> - <item>Supported SSL/TLS-versions are SSL-3.0, TLS-1.0, - TLS-1.1, and TLS-1.2.</item> + <item>Supported SSL/TLS/DTLS-versions are SSL-3.0, TLS-1.0, + TLS-1.1, TLS-1.2, DTLS-1.0 (based on TLS-1.1), DTLS-1.2 (based on TLS-1.2)</item> <item>For security reasons SSL-2.0 is not supported.</item> <item>For security reasons SSL-3.0 is no longer supported by default, but can be configured. (OTP 19) </item> @@ -47,6 +47,8 @@ but can be configured. (OTP 21) </item> <item>For security reasons DES cipher suites are no longer supported by default, but can be configured. (OTP 20) </item> + <item>For security reasons 3DES cipher suites are no longer supported by default, + but can be configured. (OTP 21) </item> <item> Renegotiation Indication Extension <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url> is supported </item> <item>Ephemeral Diffie-Hellman cipher suites are supported, @@ -74,7 +76,7 @@ <section> <title>DEPENDENCIES</title> - <p>The SSL application uses the <c>public_key</c> and + <p>The SSL application uses the <c>public_key</c>, <c>asn1</c> and Crypto application to handle public keys and encryption, hence these applications must be loaded for the SSL application to work. In an embedded environment this means they must be started with @@ -96,13 +98,20 @@ <p><c>erl -ssl protocol_version "['tlsv1.2', 'tlsv1.1']"</c></p> <taglist> - <tag><c>protocol_version = </c><seealso marker="ssl#type-protocol">ssl:protocol()</seealso><c><![CDATA[<optional>]]></c></tag> + <tag><c>protocol_version = </c><seealso marker="ssl#type-protocol">ssl:ssl_tls_protocol()</seealso><c><![CDATA[<optional>]]></c></tag> <item><p>Protocol supported by started clients and servers. If this option is not set, it defaults to all - protocols currently supported by the SSL application. + TLS protocols currently supported by the SSL application. This option can be overridden by the version option to <c>ssl:connect/[2,3]</c> and <c>ssl:listen/2</c>.</p></item> + <tag><c>dtls_protocol_version = </c><seealso marker="ssl#type-protocol">ssl:dtls_protocol()</seealso><c><![CDATA[<optional>]]></c></tag> + <item><p>Protocol supported by started clients and + servers. If this option is not set, it defaults to all + DTLS protocols currently supported by the SSL application. + This option can be overridden by the version option + to <c>ssl:connect/[2,3]</c> and <c>ssl:listen/2</c>.</p></item> + <tag><c><![CDATA[session_lifetime = integer() <optional>]]></c></tag> <item><p>Maximum lifetime of the session data in seconds. Defaults to 24 hours which is the maximum recommended lifetime by <url href="http://www.ietf.org/rfc/5246rfc.txt">RFC 5246</url>. However @@ -125,14 +134,14 @@ new client connections. If the maximum number of sessions is reached, the current cache entries will be invalidated regardless of their remaining lifetime. Defaults to - 1000.</p></item> + 1000. Recommended ssl-8.2.1 or later for this option to work as intended.</p></item> <tag> <c><![CDATA[session_cache_server_max = integer() <optional>]]></c></tag> <item><p>Limits the growth of the servers session cache, that is how many client sessions are cached by the server. If the maximum number of sessions is reached, the current cache entries will be invalidated regardless of their remaining - lifetime. Defaults to 1000.</p></item> + lifetime. Defaults to 1000. Recommended ssl-8.2.1 or later for this option to work as intended.</p></item> <tag><c><![CDATA[ssl_pem_cache_clean = integer() <optional>]]></c></tag> <item> @@ -147,9 +156,8 @@ <tag><c><![CDATA[bypass_pem_cache = boolean() <optional>]]></c></tag> <item> <p>Introduced in ssl-8.0.2. Disables the PEM-cache. - The PEM cache has proven to be a bottleneck, until the - implementation has been improved this can be used as - a workaround. Defaults to false. + Can be used as a workaround for the PEM-cache bottleneck + before ssl-8.1.1. Defaults to false. </p> </item> @@ -169,7 +177,7 @@ <title>ERROR LOGGER AND EVENT HANDLERS</title> <p>The SSL application uses the default <seealso marker="kernel:error_logger">OTP error logger</seealso> to log - unexpected errors and TLS alerts. The logging of TLS alerts may be + unexpected errors and TLS/DTLS alerts. The logging of TLS/DTLS alerts may be turned off with the <c>log_alert</c> option. </p> </section> diff --git a/lib/ssl/doc/src/ssl_distribution.xml b/lib/ssl/doc/src/ssl_distribution.xml index 7f8a08f704..e14f3f90dc 100644 --- a/lib/ssl/doc/src/ssl_distribution.xml +++ b/lib/ssl/doc/src/ssl_distribution.xml @@ -22,7 +22,7 @@ </legalnotice> - <title>Using SSL for Erlang Distribution</title> + <title>Using TLS for Erlang Distribution</title> <prepared>P Nyblom</prepared> <responsible></responsible> <docno></docno> @@ -33,7 +33,7 @@ <file>ssl_distribution.xml</file> </header> <p>This section describes how the Erlang distribution can use - SSL to get extra verification and security.</p> + TLS to get extra verification and security.</p> <p>The Erlang distribution can in theory use almost any connection-based protocol as bearer. However, a module that @@ -45,16 +45,16 @@ <p>In the SSL application, an extra distribution module, <c>inet_tls_dist</c>, can be used as an - alternative. All distribution connections will use SSL and + alternative. All distribution connections will use TLS and all participating Erlang nodes in a distributed system must use this distribution module.</p> <p>The security level depends on the parameters provided to the - SSL connection setup. Erlang node cookies are however always + TLS connection setup. Erlang node cookies are however always used, as they can be used to differentiate between two different Erlang networks.</p> - <p>To set up Erlang distribution over SSL:</p> + <p>To set up Erlang distribution over TLS:</p> <list type="bulleted"> <item><em>Step 1:</em> Build boot scripts including the @@ -63,13 +63,13 @@ <c>net_kernel</c>.</item> <item><em>Step 3:</em> Specify the security options and other SSL options.</item> - <item><em>Step 4:</em> Set up the environment to always use SSL.</item> + <item><em>Step 4:</em> Set up the environment to always use TLS.</item> </list> <p>The following sections describe these steps.</p> <section> - <title>Building Boot Scripts Including the ssl Application</title> + <title>Building Boot Scripts Including the SSL Application</title> <p>Boot scripts are built using the <c>systools</c> utility in the SASL application. For more information on <c>systools</c>, see the SASL documentation. This is only an example of @@ -90,7 +90,7 @@ STDLIB application.</p></item> </list> - <p>The following shows an example <c>.rel</c> file with SSL + <p>The following shows an example <c>.rel</c> file with TLS added:</p> <code type="none"> {release, {"OTP APN 181 01","R15A"}, {erts, "5.9"}, @@ -154,7 +154,7 @@ Eshell V5.0 (abort with ^G) <section> <title>Specifying Distribution Module for net_kernel</title> - <p>The distribution module for SSL is named <c>inet_tls_dist</c> + <p>The distribution module for SSL/TLS is named <c>inet_tls_dist</c> and is specified on the command line with option <c>-proto_dist</c>. The argument to <c>-proto_dist</c> is to be the module name without suffix <c>_dist</c>. So, this distribution @@ -174,21 +174,21 @@ Eshell V5.0 (abort with ^G) (ssl_test@myhost)1> </code> <p>However, a node started in this way refuses to talk - to other nodes, as no SSL parameters are supplied + to other nodes, as no TLS parameters are supplied (see the next section).</p> </section> <section> - <title>Specifying SSL Options</title> + <title>Specifying SSL/TLS Options</title> <p> - The SSL distribution options can be written into a file + The SSL/TLS distribution options can be written into a file that is consulted when the node is started. This file name is then specified with the command line argument <c>-ssl_dist_optfile</c>. </p> <p> - Any available SSL option can be specified in an options file, + Any available SSL/TLS option can be specified in an options file, but note that options that take a <c>fun()</c> has to use the syntax <c>fun Mod:Func/Arity</c> since a function body can not be compiled when consulting a file. @@ -202,7 +202,7 @@ Eshell V5.0 (abort with ^G) interfere severely, so beware! </p> <p> - For SSL to work, at least a public key and a certificate + For SSL/TLS to work, at least a public key and a certificate must be specified for the server side. In the following example, the PEM file <c>"/home/me/ssl/erlserver.pem"</c> contains both @@ -257,13 +257,13 @@ $ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls still be accepted if it does not present any certificate. </p> <p> - A node started in this way is fully functional, using SSL + A node started in this way is fully functional, using TLS as the distribution protocol. </p> </section> <section> - <title>Specifying SSL Options (Legacy)</title> + <title>Specifying SSL/TLS Options (Legacy)</title> <p> As in the previous section the PEM file @@ -272,9 +272,9 @@ $ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls </p> <p>On the <c>erl</c> command line you can specify options that the - SSL distribution adds when creating a socket.</p> + SSL/TLS distribution adds when creating a socket.</p> - <p>The simplest SSL options in the following list can be specified + <p>The simplest SSL/TLS options in the following list can be specified by adding the prefix <c>server_</c> or <c>client_</c> to the option name:</p> <list type="bulleted"> @@ -294,7 +294,7 @@ $ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls </list> <p>Note that <c>verify_fun</c> needs to be written in a different - form than the corresponding SSL option, since funs are not + form than the corresponding SSL/TLS option, since funs are not accepted on the command line.</p> <p>The server can also take the options <c>dhfile</c> and @@ -307,7 +307,7 @@ $ erl -boot /home/me/ssl/start_ssl -proto_dist inet_tls <p>Raw socket options, such as <c>packet</c> and <c>size</c> must not be specified on the command line.</p> - <p>The command-line argument for specifying the SSL options is named + <p>The command-line argument for specifying the SSL/TLS options is named <c>-ssl_dist_opt</c> and is to be followed by pairs of SSL options and their values. Argument <c>-ssl_dist_opt</c> can be repeated any number of times.</p> @@ -331,10 +331,10 @@ Eshell V5.0 (abort with ^G) </section> <section> - <title>Setting up Environment to Always Use SSL (Legacy)</title> + <title>Setting up Environment to Always Use SSL/TLS (Legacy)</title> <p>A convenient way to specify arguments to Erlang is to use environment variable <c>ERL_FLAGS</c>. All the flags needed to - use the SSL distribution can be specified in that variable and are + use the SSL/TLS distribution can be specified in that variable and are then interpreted as command-line arguments for all subsequent invocations of Erlang.</p> @@ -365,8 +365,8 @@ Eshell V5.0 (abort with ^G) </section> <section> - <title>Using SSL distribution over IPv6</title> - <p>It is possible to use SSL distribution over IPv6 instead of + <title>Using SSL/TLS distribution over IPv6</title> + <p>It is possible to use SSL/TLS distribution over IPv6 instead of IPv4. To do this, pass the option <c>-proto_dist inet6_tls</c> instead of <c>-proto_dist inet_tls</c> when starting Erlang, either on the command line or in the <c>ERL_FLAGS</c> environment @@ -380,6 +380,6 @@ $ erl -boot /home/me/ssl/start_ssl -proto_dist inet6_tls </code> <p>A node started in this way will only be able to communicate with - other nodes using SSL distribution over IPv6.</p> + other nodes using SSL/TLS distribution over IPv6.</p> </section> </chapter> diff --git a/lib/ssl/doc/src/ssl_introduction.xml b/lib/ssl/doc/src/ssl_introduction.xml index 25b05a769d..a416924eb1 100644 --- a/lib/ssl/doc/src/ssl_introduction.xml +++ b/lib/ssl/doc/src/ssl_introduction.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>2015</year> - <year>2015</year> + <year>2017</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> @@ -41,14 +41,15 @@ authenticate the counterpart with whom they communicate, and to exchange a symmetric key for payload encryption. The protocol provides data/message confidentiality (encryption), integrity (through message authentication code checks) - and host verification (through certificate path validation).</p> + and host verification (through certificate path validation). DTLS (Datagram Transport Layer Security) that + is based on TLS but datagram oriented instead of stream oriented.</p> </section> <section> <title>Prerequisites</title> <p>It is assumed that the reader is familiar with the Erlang programming language, the concepts of OTP, and has a basic - understanding of SSL/TLS.</p> + understanding of SSL/TLS/DTLS.</p> </section> </chapter> diff --git a/lib/ssl/doc/src/ssl_protocol.xml b/lib/ssl/doc/src/ssl_protocol.xml index 31a22db58b..0b12dc7dc5 100644 --- a/lib/ssl/doc/src/ssl_protocol.xml +++ b/lib/ssl/doc/src/ssl_protocol.xml @@ -22,7 +22,7 @@ </legalnotice> - <title>TLS and its Predecessor, SSL</title> + <title>TLS/DTLS and TLS Predecessor, SSL</title> <prepared></prepared> <responsible></responsible> <docno></docno> @@ -33,7 +33,7 @@ <file>ssl_protocol.xml</file> </header> - <p>The Erlang SSL application implements the SSL/TLS protocol + <p>The Erlang SSL application implements the SSL/TLS/DTLS protocol for the currently supported versions, see the <seealso marker="ssl">ssl(3)</seealso> manual page. </p> @@ -41,20 +41,22 @@ <p>By default SSL/TLS is run over the TCP/IP protocol even though you can plug in any other reliable transport protocol with the same Application Programming Interface (API) as the - <c>gen_tcp</c> module in Kernel.</p> + <c>gen_tcp</c> module in Kernel. DTLS is by default run over UDP/IP, + which means that application data has no delivery guarentees. Other + transports, such as SCTP, may be supported in future releases.</p> <p>If a client and a server wants to use an upgrade mechanism, such as - defined by RFC 2817, to upgrade a regular TCP/IP connection to an SSL + defined by RFC 2817, to upgrade a regular TCP/IP connection to an TLS connection, this is supported by the Erlang SSL application API. This can be useful for, for example, supporting HTTP and HTTPS on the same port and - implementing virtual hosting. + implementing virtual hosting. Note this is a TLS feature only. </p> <section> <title>Security Overview</title> <p>To achieve authentication and privacy, the client and server - perform a TLS handshake procedure before transmitting or receiving + perform a TLS/DTLS handshake procedure before transmitting or receiving any data. During the handshake, they agree on a protocol version and cryptographic algorithms, generate shared secrets using public key cryptographies, and optionally authenticate each other with @@ -73,10 +75,10 @@ <p>The keys for the symmetric encryption are generated uniquely for each connection and are based on a secret negotiated - in the TLS handshake.</p> + in the TLS/DTLS handshake.</p> - <p>The TLS handshake protocol and data transfer is run on top of - the TLS Record Protocol, which uses a keyed-hash Message + <p>The TLS/DTLS handshake protocol and data transfer is run on top of + the TLS/DTLS Record Protocol, which uses a keyed-hash Message Authenticity Code (MAC), or a Hash-based MAC (HMAC), to protect the message data integrity. From the TLS RFC: "A Message Authentication Code is a @@ -152,8 +154,8 @@ from it was saved, for security reasons. The amount of time the session data is to be saved can be configured.</p> - <p>By default the SSL clients try to reuse an available session and - by default the SSL servers agree to reuse sessions when clients + <p>By default the TLS/DTLS clients try to reuse an available session and + by default the TLS/DTLS servers agree to reuse sessions when clients ask for it.</p> </section> diff --git a/lib/ssl/doc/src/using_ssl.xml b/lib/ssl/doc/src/using_ssl.xml index 61918a346d..c369c3c133 100644 --- a/lib/ssl/doc/src/using_ssl.xml +++ b/lib/ssl/doc/src/using_ssl.xml @@ -22,7 +22,7 @@ </legalnotice> - <title>Using SSL API</title> + <title>Using SSL application API</title> <prepared></prepared> <responsible></responsible> <docno></docno> @@ -51,7 +51,7 @@ <section> <title>Minimal Example</title> - <note><p> The minimal setup is not the most secure setup of SSL.</p> + <note><p> The minimal setup is not the most secure setup of SSL/TLS/DTLS.</p> </note> <p>To set up client/server connections:</p> @@ -60,27 +60,27 @@ <code type="erl">1 server> ssl:start(). ok</code> - <p><em>Step 2:</em> Create an SSL listen socket:</p> + <p><em>Step 2:</em> Create an TLS listen socket: (To run DTLS add the option {protocol, dtls})</p> <code type="erl">2 server> {ok, ListenSocket} = ssl:listen(9999, [{certfile, "cert.pem"}, {keyfile, "key.pem"},{reuseaddr, true}]). {ok,{sslsocket, [...]}}</code> - <p><em>Step 3:</em> Do a transport accept on the SSL listen socket:</p> + <p><em>Step 3:</em> Do a transport accept on the TLS listen socket:</p> <code type="erl">3 server> {ok, Socket} = ssl:transport_accept(ListenSocket). {ok,{sslsocket, [...]}}</code> - <p><em>Step 4:</em> Start the client side:</p> + <p><em>Step 4:</em> Start the client side: </p> <code type="erl">1 client> ssl:start(). ok</code> - + <p> To run DTLS add the option {protocol, dtls} to third argument.</p> <code type="erl">2 client> {ok, Socket} = ssl:connect("localhost", 9999, [], infinity). {ok,{sslsocket, [...]}}</code> - <p><em>Step 5:</em> Do the SSL handshake:</p> + <p><em>Step 5:</em> Do the TLS handshake:</p> <code type="erl">4 server> ok = ssl:ssl_accept(Socket). ok</code> - <p><em>Step 6:</em> Send a message over SSL:</p> + <p><em>Step 6:</em> Send a message over TLS:</p> <code type="erl">5 server> ssl:send(Socket, "foo"). ok</code> @@ -92,7 +92,7 @@ ok</code> </section> <section> - <title>Upgrade Example</title> + <title>Upgrade Example - TLS only </title> <note><p>To upgrade a TCP/IP connection to an SSL connection, the client and server must agree to do so. The agreement @@ -125,24 +125,24 @@ ok</code> <code type="erl">4 server> inet:setopts(Socket, [{active, false}]). ok</code> - <p><em>Step 6:</em> Do the SSL handshake:</p> - <code type="erl">5 server> {ok, SSLSocket} = ssl:ssl_accept(Socket, [{cacertfile, "cacerts.pem"}, + <p><em>Step 6:</em> Do the TLS handshake:</p> + <code type="erl">5 server> {ok, TLSSocket} = ssl:ssl_accept(Socket, [{cacertfile, "cacerts.pem"}, {certfile, "cert.pem"}, {keyfile, "key.pem"}]). {ok,{sslsocket,[...]}}</code> - <p><em>Step 7:</em> Upgrade to an SSL connection. The client and server + <p><em>Step 7:</em> Upgrade to an TLS connection. The client and server must agree upon the upgrade. The server must call <c>ssl:accept/2</c> before the client calls <c>ssl:connect/3.</c></p> - <code type="erl">3 client>{ok, SSLSocket} = ssl:connect(Socket, [{cacertfile, "cacerts.pem"}, + <code type="erl">3 client>{ok, TLSSocket} = ssl:connect(Socket, [{cacertfile, "cacerts.pem"}, {certfile, "cert.pem"}, {keyfile, "key.pem"}], infinity). {ok,{sslsocket,[...]}}</code> - <p><em>Step 8:</em> Send a message over SSL:</p> - <code type="erl">4 client> ssl:send(SSLSocket, "foo"). + <p><em>Step 8:</em> Send a message over TLS:</p> + <code type="erl">4 client> ssl:send(TLSSocket, "foo"). ok</code> - <p><em>Step 9:</em> Set <c>active true</c> on the SSL socket:</p> - <code type="erl">4 server> ssl:setopts(SSLSocket, [{active, true}]). + <p><em>Step 9:</em> Set <c>active true</c> on the TLS socket:</p> + <code type="erl">4 server> ssl:setopts(TLSSocket, [{active, true}]). ok</code> <p><em>Step 10:</em> Flush the shell message queue to see that the message diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl index 3b5a548f72..fb12a729b1 100644 --- a/lib/ssl/src/dtls_connection.erl +++ b/lib/ssl/src/dtls_connection.erl @@ -759,10 +759,12 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, _}, User, flight_state = {retransmit, ?INITIAL_RETRANSMIT_TIMEOUT} }. -next_dtls_record(Data, #state{protocol_buffers = #protocol_buffers{ +next_dtls_record(Data, StateName, #state{protocol_buffers = #protocol_buffers{ dtls_record_buffer = Buf0, dtls_cipher_texts = CT0} = Buffers} = State0) -> - case dtls_record:get_dtls_records(Data, Buf0) of + case dtls_record:get_dtls_records(Data, + acceptable_record_versions(StateName, State0), + Buf0) of {Records, Buf1} -> CT1 = CT0 ++ Records, next_record(State0#state{protocol_buffers = @@ -772,6 +774,11 @@ next_dtls_record(Data, #state{protocol_buffers = #protocol_buffers{ Alert end. +acceptable_record_versions(hello, _) -> + [dtls_record:protocol_version(Vsn) || Vsn <- ?ALL_DATAGRAM_SUPPORTED_VERSIONS]; +acceptable_record_versions(_, #state{negotiated_version = Version}) -> + [Version]. + dtls_handshake_events(Packets) -> lists:map(fun(Packet) -> {next_event, internal, {handshake, Packet}} @@ -829,7 +836,7 @@ handle_client_hello(#client_hello{client_version = ClientVersion} = Hello, %% raw data from socket, unpack records handle_info({Protocol, _, _, _, Data}, StateName, #state{data_tag = Protocol} = State0) -> - case next_dtls_record(Data, State0) of + case next_dtls_record(Data, StateName, State0) of {Record, State} -> next_event(StateName, Record, State); #alert{} = Alert -> diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index 2dcc6efc91..316de05532 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -30,7 +30,7 @@ -include("ssl_cipher.hrl"). %% Handling of incoming data --export([get_dtls_records/2, init_connection_states/2, empty_connection_state/1]). +-export([get_dtls_records/3, init_connection_states/2, empty_connection_state/1]). -export([save_current_connection_state/2, next_epoch/2, get_connection_state_by_epoch/3, replay_detect/2, init_connection_state_seq/2, current_connection_state_epoch/2]). @@ -163,17 +163,25 @@ current_connection_state_epoch(#{current_write := #{epoch := Epoch}}, Epoch. %%-------------------------------------------------------------------- --spec get_dtls_records(binary(), binary()) -> {[binary()], binary()} | #alert{}. +-spec get_dtls_records(binary(), [dtls_version()], binary()) -> {[binary()], binary()} | #alert{}. %% %% Description: Given old buffer and new data from UDP/SCTP, packs up a records %% and returns it as a list of tls_compressed binaries also returns leftover %% data %%-------------------------------------------------------------------- -get_dtls_records(Data, <<>>) -> - get_dtls_records_aux(Data, []); -get_dtls_records(Data, Buffer) -> - get_dtls_records_aux(list_to_binary([Buffer, Data]), []). - +get_dtls_records(Data, Versions, Buffer) -> + BinData = list_to_binary([Buffer, Data]), + case erlang:byte_size(BinData) of + N when N >= 3 -> + case assert_version(BinData, Versions) of + true -> + get_dtls_records_aux(BinData, []); + false -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end; + _ -> + get_dtls_records_aux(BinData, []) + end. %%==================================================================== %% Encoding DTLS records @@ -397,6 +405,8 @@ initial_connection_state(ConnectionEnd, BeastMitigation) -> client_verify_data => undefined, server_verify_data => undefined }. +assert_version(<<?BYTE(_), ?BYTE(MajVer), ?BYTE(MinVer), _/binary>>, Versions) -> + is_acceptable_version({MajVer, MinVer}, Versions). get_dtls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer), ?UINT16(Epoch), ?UINT48(SequenceNumber), @@ -431,15 +441,11 @@ get_dtls_records_aux(<<?BYTE(?CHANGE_CIPHER_SPEC),?BYTE(MajVer),?BYTE(MinVer), epoch = Epoch, sequence_number = SequenceNumber, fragment = Data} | Acc]); -get_dtls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), +get_dtls_records_aux(<<?BYTE(_), ?BYTE(_MajVer), ?BYTE(_MinVer), ?UINT16(Length), _/binary>>, _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH -> ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); -get_dtls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc) - when Length0 > ?MAX_CIPHER_TEXT_LENGTH -> - ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); - get_dtls_records_aux(Data, Acc) -> case size(Data) =< ?MAX_CIPHER_TEXT_LENGTH + ?INITIAL_BYTES of true -> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 656ed94ea5..a298012f26 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -39,7 +39,7 @@ ]). %% SSL/TLS protocol handling --export([cipher_suites/0, cipher_suites/1, eccs/0, eccs/1, versions/0, +-export([cipher_suites/0, cipher_suites/1, cipher_suites/2, eccs/0, eccs/1, versions/0, format_error/1, renegotiate/1, prf/5, negotiated_protocol/1, connection_information/1, connection_information/2]). %% Misc @@ -383,13 +383,31 @@ cipher_suites() -> %% Description: Returns all supported cipher suites. %%-------------------------------------------------------------------- cipher_suites(erlang) -> - [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(default)]; - + Version = tls_record:highest_protocol_version([]), + cipher_suites(erlang, Version); cipher_suites(openssl) -> - [ssl_cipher:openssl_suite_name(Suite) || Suite <- available_suites(default)]; - + Version = tls_record:highest_protocol_version([]), + cipher_suites(openssl, Version); cipher_suites(all) -> - [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(all)]. + Version = tls_record:highest_protocol_version([]), + cipher_suites(all, Version). + +%%-------------------------------------------------------------------- +-spec cipher_suites(erlang | openssl | all, tls_record:tls_version() | + dtls_record:dtls_version()) -> [ssl_cipher:old_erl_cipher_suite() | string()]. +%% Description: Returns all supported cipher suites. +%%-------------------------------------------------------------------- +cipher_suites(Type, Version) when Version == 'dtlsv1'; + Version == 'dtlsv1.2' -> + cipher_suites(Type, dtls_record:protocol_version(Version)); +cipher_suites(Type, Version) when is_atom(Version) -> + cipher_suites(Type, tls_record:protocol_version(Version)); +cipher_suites(erlang, Version) -> + [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(default, Version)]; +cipher_suites(openssl, Version) -> + [ssl_cipher:openssl_suite_name(Suite) || Suite <- available_suites(default, Version)]; +cipher_suites(all, Version) -> + [ssl_cipher:erl_suite_definition(Suite) || Suite <- available_suites(all, Version)]. %%-------------------------------------------------------------------- -spec eccs() -> tls_v1:curves(). @@ -410,6 +428,11 @@ eccs({3,0}) -> eccs({3,_}) -> Curves = tls_v1:ecc_curves(all), eccs_filter_supported(Curves); +eccs({_,_} = DTLSVersion) -> + eccs(dtls_v1:corresponding_tls_version(DTLSVersion)); +eccs(DTLSAtomVersion) when DTLSAtomVersion == 'dtlsv1'; + DTLSAtomVersion == 'dtlsv2' -> + eccs(dtls_record:protocol_version(DTLSAtomVersion)); eccs(AtomVersion) when is_atom(AtomVersion) -> eccs(tls_record:protocol_version(AtomVersion)). @@ -542,16 +565,23 @@ sockname(#sslsocket{pid = Pid, fd = {Transport, Socket, _, _}}) when is_pid(Pid) %%--------------------------------------------------------------- -spec versions() -> [{ssl_app, string()} | {supported, [tls_record:tls_atom_version()]} | - {available, [tls_record:tls_atom_version()]}]. + {supported_dtls, [dtls_record:dtls_atom_version()]} | + {available, [tls_record:tls_atom_version()]} | + {available_dtls, [dtls_record:dtls_atom_version()]}]. %% %% Description: Returns a list of relevant versions. %%-------------------------------------------------------------------- versions() -> - Vsns = tls_record:supported_protocol_versions(), - SupportedVsns = [tls_record:protocol_version(Vsn) || Vsn <- Vsns], - AvailableVsns = ?ALL_AVAILABLE_VERSIONS, - %% TODO Add DTLS versions when supported - [{ssl_app, ?VSN}, {supported, SupportedVsns}, {available, AvailableVsns}]. + TLSVsns = tls_record:supported_protocol_versions(), + DTLSVsns = dtls_record:supported_protocol_versions(), + SupportedTLSVsns = [tls_record:protocol_version(Vsn) || Vsn <- TLSVsns], + SupportedDTLSVsns = [dtls_record:protocol_version(Vsn) || Vsn <- DTLSVsns], + AvailableTLSVsns = ?ALL_AVAILABLE_VERSIONS, + AvailableDTLSVsns = ?ALL_AVAILABLE_DATAGRAM_VERSIONS, + [{ssl_app, ?VSN}, {supported, SupportedTLSVsns}, + {supported_dtls, SupportedDTLSVsns}, + {available, AvailableTLSVsns}, + {available_dtls, AvailableDTLSVsns}]. %%--------------------------------------------------------------- @@ -633,12 +663,10 @@ tls_version({254, _} = Version) -> %%%-------------------------------------------------------------------- %% Possible filters out suites not supported by crypto -available_suites(default) -> - Version = tls_record:highest_protocol_version([]), +available_suites(default, Version) -> ssl_cipher:filter_suites(ssl_cipher:suites(Version)); -available_suites(all) -> - Version = tls_record:highest_protocol_version([]), +available_suites(all, Version) -> ssl_cipher:filter_suites(ssl_cipher:all_suites(Version)). do_listen(Port, #config{transport_info = {Transport, _, _, _}} = Config, tls_connection) -> diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index dba8e5a311..7c5cff3665 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -37,7 +37,7 @@ erl_suite_definition/1, cipher_init/3, decipher/6, cipher/5, decipher_aead/6, cipher_aead/6, suite/1, suites/1, all_suites/1, - ec_keyed_suites/0, anonymous_suites/1, psk_suites/1, srp_suites/0, + ec_keyed_suites/0, chacha_suites/1, anonymous_suites/1, psk_suites/1, srp_suites/0, rc4_suites/1, des_suites/1, rsa_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2, is_fallback/1, random_bytes/1, calc_mac_hash/4, @@ -320,7 +320,8 @@ suites({_, Minor}) -> all_suites({3, _} = Version) -> suites(Version) - ++ anonymous_suites(Version) + ++ chacha_suites(Version) + ++ anonymous_suites(Version) ++ psk_suites(Version) ++ srp_suites() ++ rc4_suites(Version) @@ -328,6 +329,19 @@ all_suites({3, _} = Version) -> ++ rsa_suites(Version); all_suites(Version) -> dtls_v1:all_suites(Version). +%%-------------------------------------------------------------------- +-spec chacha_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. +%% +%% Description: Returns list of the chacha cipher suites, only supported +%% if explicitly set by user for now due to interop problems, proably need +%% to be fixed in crypto. +%%-------------------------------------------------------------------- +chacha_suites({3, _}) -> + [?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, + ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, + ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256]; +chacha_suites(_) -> + []. %%-------------------------------------------------------------------- -spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. @@ -335,7 +349,6 @@ all_suites(Version) -> %% Description: Returns a list of the anonymous cipher suites, only supported %% if explicitly set by user. Intended only for testing. %%-------------------------------------------------------------------- - anonymous_suites({3, N}) -> anonymous_suites(N); anonymous_suites({254, _} = Version) -> @@ -457,7 +470,14 @@ rc4_suites(N) when N =< 3 -> %%-------------------------------------------------------------------- des_suites(_)-> [?TLS_DHE_RSA_WITH_DES_CBC_SHA, - ?TLS_RSA_WITH_DES_CBC_SHA]. + ?TLS_RSA_WITH_DES_CBC_SHA, + ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA, + ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA + ]. %%-------------------------------------------------------------------- -spec rsa_suites(Version::ssl_record:ssl_version() | integer()) -> [cipher_suite()]. diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 9bb1cbaeb0..bbe1374fec 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -73,6 +73,7 @@ %% sslv3 is considered insecure due to lack of padding check (Poodle attack) %% Keep as interop with legacy software but do not support as default -define(ALL_AVAILABLE_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1, sslv3]). +-define(ALL_AVAILABLE_DATAGRAM_VERSIONS, ['dtlsv1.2', dtlsv1]). -define(ALL_SUPPORTED_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1]). -define(MIN_SUPPORTED_VERSIONS, ['tlsv1.1', tlsv1]). -define(ALL_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]). diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index cf2f3a2b62..2872ca9fe5 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -640,18 +640,34 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us flight_buffer = [] }. -next_tls_record(Data, #state{protocol_buffers = #protocol_buffers{tls_record_buffer = Buf0, - tls_cipher_texts = CT0} = Buffers} = State0) -> - case tls_record:get_tls_records(Data, Buf0) of +next_tls_record(Data, StateName, #state{protocol_buffers = + #protocol_buffers{tls_record_buffer = Buf0, + tls_cipher_texts = CT0} = Buffers} + = State0) -> + case tls_record:get_tls_records(Data, + acceptable_record_versions(StateName, State0), + Buf0) of {Records, Buf1} -> CT1 = CT0 ++ Records, next_record(State0#state{protocol_buffers = Buffers#protocol_buffers{tls_record_buffer = Buf1, tls_cipher_texts = CT1}}); #alert{} = Alert -> - Alert + handle_record_alert(Alert, State0) end. +acceptable_record_versions(hello, #state{ssl_options = #ssl_options{v2_hello_compatible = true}}) -> + [tls_record:protocol_version(Vsn) || Vsn <- ?ALL_AVAILABLE_VERSIONS ++ ['sslv2']]; +acceptable_record_versions(hello, _) -> + [tls_record:protocol_version(Vsn) || Vsn <- ?ALL_AVAILABLE_VERSIONS]; +acceptable_record_versions(_, #state{negotiated_version = Version}) -> + [Version]. +handle_record_alert(#alert{description = ?BAD_RECORD_MAC}, + #state{ssl_options = #ssl_options{v2_hello_compatible = true}}) -> + ?ALERT_REC(?FATAL, ?PROTOCOL_VERSION); +handle_record_alert(Alert, _) -> + Alert. + tls_handshake_events(Packets) -> lists:map(fun(Packet) -> {next_event, internal, {handshake, Packet}} @@ -660,7 +676,7 @@ tls_handshake_events(Packets) -> %% raw data from socket, upack records handle_info({Protocol, _, Data}, StateName, #state{data_tag = Protocol} = State0) -> - case next_tls_record(Data, State0) of + case next_tls_record(Data, StateName, State0) of {Record, State} -> next_event(StateName, Record, State); #alert{} = Alert -> diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index ab179c1bf0..188ec6809d 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -32,7 +32,7 @@ -include("ssl_cipher.hrl"). %% Handling of incoming data --export([get_tls_records/2, init_connection_states/2]). +-export([get_tls_records/3, init_connection_states/2]). %% Encoding TLS records -export([encode_handshake/3, encode_alert_record/3, @@ -75,16 +75,25 @@ init_connection_states(Role, BeastMitigation) -> pending_write => Pending}. %%-------------------------------------------------------------------- --spec get_tls_records(binary(), binary()) -> {[binary()], binary()} | #alert{}. +-spec get_tls_records(binary(), [tls_version()], binary()) -> {[binary()], binary()} | #alert{}. %% %% and returns it as a list of tls_compressed binaries also returns leftover %% Description: Given old buffer and new data from TCP, packs up a records %% data %%-------------------------------------------------------------------- -get_tls_records(Data, <<>>) -> - get_tls_records_aux(Data, []); -get_tls_records(Data, Buffer) -> - get_tls_records_aux(list_to_binary([Buffer, Data]), []). +get_tls_records(Data, Versions, Buffer) -> + BinData = list_to_binary([Buffer, Data]), + case erlang:byte_size(BinData) of + N when N >= 3 -> + case assert_version(BinData, Versions) of + true -> + get_tls_records_aux(BinData, []); + false -> + ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) + end; + _ -> + get_tls_records_aux(BinData, []) + end. %%==================================================================== %% Encoding @@ -385,6 +394,19 @@ initial_connection_state(ConnectionEnd, BeastMitigation) -> server_verify_data => undefined }. +assert_version(<<1:1, Length0:15, Data0:Length0/binary, _/binary>>, Versions) -> + case Data0 of + <<?BYTE(?CLIENT_HELLO), ?BYTE(Major), ?BYTE(Minor), _/binary>> -> + %% First check v2_hello_compatible mode is active + lists:member({2,0}, Versions) andalso + %% andalso we want to negotiate higher version + lists:member({Major, Minor}, Versions -- [{2,0}]); + _ -> + false + end; +assert_version(<<?BYTE(_), ?BYTE(MajVer), ?BYTE(MinVer), _/binary>>, Versions) -> + is_acceptable_version({MajVer, MinVer}, Versions). + get_tls_records_aux(<<?BYTE(?APPLICATION_DATA),?BYTE(MajVer),?BYTE(MinVer), ?UINT16(Length), Data:Length/binary, Rest/binary>>, Acc) -> @@ -428,10 +450,9 @@ get_tls_records_aux(<<1:1, Length0:15, Data0:Length0/binary, Rest/binary>>, end; get_tls_records_aux(<<0:1, _CT:7, ?BYTE(_MajVer), ?BYTE(_MinVer), - ?UINT16(Length), _/binary>>, + ?UINT16(Length), _/binary>>, _Acc) when Length > ?MAX_CIPHER_TEXT_LENGTH -> ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); - get_tls_records_aux(<<1:1, Length0:15, _/binary>>,_Acc) when Length0 > ?MAX_CIPHER_TEXT_LENGTH -> ?ALERT_REC(?FATAL, ?RECORD_OVERFLOW); diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index af3f037477..a31ab8d044 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -208,14 +208,7 @@ suites(Minor) when Minor == 1; Minor == 2 -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, - ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA, - - ?TLS_ECDHE_ECDSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_ECDHE_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_DHE_DSS_WITH_3DES_EDE_CBC_SHA, - ?TLS_ECDH_ECDSA_WITH_3DES_EDE_CBC_SHA, - ?TLS_ECDH_RSA_WITH_3DES_EDE_CBC_SHA + ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA ]; suites(3) -> [?TLS_ECDHE_ECDSA_WITH_AES_256_GCM_SHA384, @@ -227,10 +220,6 @@ suites(3) -> ?TLS_ECDH_ECDSA_WITH_AES_256_CBC_SHA384, ?TLS_ECDH_RSA_WITH_AES_256_CBC_SHA384, - ?TLS_ECDHE_ECDSA_WITH_CHACHA20_POLY1305_SHA256, - ?TLS_ECDHE_RSA_WITH_CHACHA20_POLY1305_SHA256, - ?TLS_DHE_RSA_WITH_CHACHA20_POLY1305_SHA256, - ?TLS_DHE_RSA_WITH_AES_256_GCM_SHA384, ?TLS_DHE_DSS_WITH_AES_256_GCM_SHA384, ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA256, diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index dc602910a1..f13bd53a7c 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -213,6 +213,8 @@ cipher_tests() -> ciphers_rsa_signed_certs_openssl_names, ciphers_dsa_signed_certs, ciphers_dsa_signed_certs_openssl_names, + chacha_rsa_cipher_suites, + chacha_ecdsa_cipher_suites, anonymous_cipher_suites, psk_cipher_suites, psk_with_hint_cipher_suites, @@ -2371,7 +2373,24 @@ ciphers_dsa_signed_certs_openssl_names() -> ciphers_dsa_signed_certs_openssl_names(Config) when is_list(Config) -> Ciphers = ssl_test_lib:openssl_dsa_suites(), run_suites(Ciphers, Config, dsa). + %%------------------------------------------------------------------- +chacha_rsa_cipher_suites()-> + [{doc,"Test the cacha with ECDSA signed certs ciphersuites"}]. +chacha_rsa_cipher_suites(Config) when is_list(Config) -> + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = [S || {KeyEx,_,_} = S <- ssl_test_lib:chacha_suites(NVersion), + KeyEx == ecdhe_rsa, KeyEx == dhe_rsa], + run_suites(Ciphers, Config, chacha_ecdsa). + +%%------------------------------------------------------------------- +chacha_ecdsa_cipher_suites()-> + [{doc,"Test the cacha with ECDSA signed certs ciphersuites"}]. +chacha_ecdsa_cipher_suites(Config) when is_list(Config) -> + NVersion = ssl_test_lib:protocol_version(Config, tuple), + Ciphers = [S || {ecdhe_ecdsa,_,_} = S <- ssl_test_lib:chacha_suites(NVersion)], + run_suites(Ciphers, Config, chacha_rsa). +%%----------------------------------------------------------------- anonymous_cipher_suites()-> [{doc,"Test the anonymous ciphersuites"}]. anonymous_cipher_suites(Config) when is_list(Config) -> @@ -2451,14 +2470,15 @@ rc4_ecdsa_cipher_suites(Config) when is_list(Config) -> des_rsa_cipher_suites()-> [{doc, "Test the des_rsa ciphersuites"}]. des_rsa_cipher_suites(Config) when is_list(Config) -> - Ciphers = ssl_test_lib:des_suites(Config), + NVersion = tls_record:highest_protocol_version([]), + Ciphers = [S || {rsa,_,_} = S <- ssl_test_lib:des_suites(NVersion)], run_suites(Ciphers, Config, des_rsa). %------------------------------------------------------------------- des_ecdh_rsa_cipher_suites()-> [{doc, "Test ECDH rsa signed ciphersuites"}]. des_ecdh_rsa_cipher_suites(Config) when is_list(Config) -> NVersion = ssl_test_lib:protocol_version(Config, tuple), - Ciphers = ssl_test_lib:des_suites(NVersion), + Ciphers = [S || {dhe_rsa,_,_} = S <- ssl_test_lib:des_suites(NVersion)], run_suites(Ciphers, Config, des_dhe_rsa). %%-------------------------------------------------------------------- @@ -3151,18 +3171,25 @@ no_reuses_session_server_restart_new_cert_file(Config) when is_list(Config) -> %%-------------------------------------------------------------------- defaults(Config) when is_list(Config)-> - [_, - {supported, Supported}, - {available, Available}] - = ssl:versions(), - true = lists:member(sslv3, Available), - false = lists:member(sslv3, Supported), + Versions = ssl:versions(), + true = lists:member(sslv3, proplists:get_value(available, Versions)), + false = lists:member(sslv3, proplists:get_value(supported, Versions)), + true = lists:member('tlsv1', proplists:get_value(available, Versions)), + true = lists:member('tlsv1', proplists:get_value(supported, Versions)), + true = lists:member('tlsv1.1', proplists:get_value(available, Versions)), + true = lists:member('tlsv1.1', proplists:get_value(supported, Versions)), + true = lists:member('tlsv1.2', proplists:get_value(available, Versions)), + true = lists:member('tlsv1.2', proplists:get_value(supported, Versions)), false = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites()), true = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites(all)), false = lists:member({rsa,des_cbc,sha}, ssl:cipher_suites()), true = lists:member({rsa,des_cbc,sha}, ssl:cipher_suites(all)), false = lists:member({dhe_rsa,des_cbc,sha}, ssl:cipher_suites()), - true = lists:member({dhe_rsa,des_cbc,sha}, ssl:cipher_suites(all)). + true = lists:member({dhe_rsa,des_cbc,sha}, ssl:cipher_suites(all)), + true = lists:member('dtlsv1.2', proplists:get_value(available_dtls, Versions)), + true = lists:member('dtlsv1', proplists:get_value(available_dtls, Versions)), + true = lists:member('dtlsv1.2', proplists:get_value(supported_dtls, Versions)), + true = lists:member('dtlsv1', proplists:get_value(supported_dtls, Versions)). %%-------------------------------------------------------------------- reuseaddr() -> @@ -4683,7 +4710,15 @@ run_suites(Ciphers, Config, Type) -> des_rsa -> {ssl_test_lib:ssl_options(client_verification_opts, Config), [{ciphers, Ciphers} | - ssl_test_lib:ssl_options(server_verification_opts, Config)]} + ssl_test_lib:ssl_options(server_verification_opts, Config)]}; + chacha_rsa -> + {ssl_test_lib:ssl_options(client_verification_opts, Config), + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_verification_opts, Config)]}; + chacha_ecdsa -> + {ssl_test_lib:ssl_options(client_verification_opts, Config), + [{ciphers, Ciphers} | + ssl_test_lib:ssl_options(server_ecdsa_opts, Config)]} end, Result = lists:map(fun(Cipher) -> cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end, diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index e74529b455..94d10b2f9b 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1068,6 +1068,10 @@ srp_dss_suites() -> S <- [{srp_dss, '3des_ede_cbc', sha}, {srp_dss, aes_128_cbc, sha}, {srp_dss, aes_256_cbc, sha}]])]. + +chacha_suites(Version) -> + [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:chacha_suites(Version))]. + rc4_suites(Version) -> [ssl_cipher:erl_suite_definition(S) || S <- ssl_cipher:filter_suites(ssl_cipher:rc4_suites(Version))]. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index bbb925e742..33cdc325f4 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1016,7 +1016,7 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) -> ct:log("Ports ~p~n", [[erlang:port_info(P) || P <- erlang:ports()]]), consume_port_exit(OpenSslPort), - ssl_test_lib:check_result(Server, {error, {tls_alert, "handshake failure"}}), + ssl_test_lib:check_result(Server, {error, {tls_alert, "bad record mac"}}), process_flag(trap_exit, false). %%-------------------------------------------------------------------- ssl2_erlang_server_openssl_client_comp() -> diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml index 4a824f073e..be0d64feba 100644 --- a/lib/stdlib/doc/src/gen_statem.xml +++ b/lib/stdlib/doc/src/gen_statem.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>2016</year><year>2017</year> + <year>2016</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -543,7 +543,23 @@ handle_event(_, _, State, Data) -> <name name="event_type"/> <desc> <p> - External events are of three types: + There are 3 categories of events: + <seealso marker="#type-external_event_type">external</seealso>, + <seealso marker="#type-timeout_event_type">timeout</seealso>, + and <c>internal</c>. + </p> + <p> + <c>internal</c> events can only be generated by the + state machine itself through the state transition action + <seealso marker="#type-action"><c>next_event</c></seealso>. + </p> + </desc> + </datatype> + <datatype> + <name name="external_event_type"/> + <desc> + <p> + External events are of 3 types: <c>{call,<anno>From</anno>}</c>, <c>cast</c>, or <c>info</c>. <seealso marker="#call/2">Calls</seealso> (synchronous) and @@ -551,12 +567,17 @@ handle_event(_, _, State, Data) -> originate from the corresponding API functions. For calls, the event contains whom to reply to. Type <c>info</c> originates from regular process messages sent - to the <c>gen_statem</c>. The state machine - implementation can, in addition to the above, - generate - <seealso marker="#type-event_type"><c>events of types</c></seealso> - <c>timeout</c>, <c>{timeout,<anno>Name</anno>}</c>, - <c>state_timeout</c>, and <c>internal</c> to itself. + to the <c>gen_statem</c>. + </p> + </desc> + </datatype> + <datatype> + <name name="timeout_event_type"/> + <desc> + <p> + There are 3 types of timeout events that the state machine + can generate for itself with the corresponding + <seealso marker="#type-timeout_action">timeout_action()</seealso>s. </p> </desc> </datatype> @@ -1026,6 +1047,25 @@ handle_event(_, _, State, Data) -> for this state transition. </p> </item> + </taglist> + </desc> + </datatype> + <datatype> + <name name="timeout_action"/> + <desc> + <p> + These state transition actions can be invoked by + returning them from the + <seealso marker="#state callback">state callback</seealso>, from + <seealso marker="#Module:init/1"><c>Module:init/1</c></seealso> + or by giving them to + <seealso marker="#enter_loop/5"><c>enter_loop/5,6</c></seealso>. + </p> + <p> + These timeout actions sets timeout + <seealso marker="#type-transition_option">transition options</seealso>. + </p> + <taglist> <tag><c>Timeout</c></tag> <item> <p> diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index a9b98911e2..73e4457bd0 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -125,7 +125,8 @@ | {'logfile', string()}. -type option() :: {'timeout', timeout()} | {'debug', [debug_flag()]} - | {'spawn_opt', [proc_lib:spawn_option()]}. + | {'spawn_opt', [proc_lib:spawn_option()]} + | {'hibernate_after', timeout()}. -type emgr_ref() :: atom() | {atom(), atom()} | {'global', atom()} | {'via', atom(), term()} | pid(). -type start_ret() :: {'ok', pid()} | {'error', term()}. diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 96a53426e2..8c7db65563 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -198,7 +198,7 @@ %%% start(Name, Mod, Args, Options) %%% start_link(Mod, Args, Options) %%% start_link(Name, Mod, Args, Options) where: -%%% Name ::= {local, atom()} | {global, atom()} | {via, atom(), term()} +%%% Name ::= {local, atom()} | {global, term()} | {via, atom(), term()} %%% Mod ::= atom(), callback module implementing the 'real' fsm %%% Args ::= term(), init arguments (to Mod:init/1) %%% Options ::= [{debug, [Flag]}] diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index cd6312855d..1a7736fc7e 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2016-2017. All Rights Reserved. +%% Copyright Ericsson AB 2016-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -78,9 +78,11 @@ -type data() :: term(). -type event_type() :: - {'call',From :: from()} | 'cast' | 'info' | - 'timeout' | {'timeout', Name :: term()} | 'state_timeout' | - 'internal'. + external_event_type() | timeout_event_type() | 'internal'. +-type external_event_type() :: + {'call',From :: from()} | 'cast' | 'info'. +-type timeout_event_type() :: + 'timeout' | {'timeout', Name :: term()} | 'state_timeout'. -type callback_mode_result() :: callback_mode() | [callback_mode() | state_enter()]. @@ -138,7 +140,9 @@ -type enter_action() :: 'hibernate' | % Set the hibernate option {'hibernate', Hibernate :: hibernate()} | - %% + timeout_action() | + reply_action(). +-type timeout_action() :: (Timeout :: event_timeout()) | % {timeout,Timeout} {'timeout', % Set the event_timeout option Time :: event_timeout(), EventContent :: term()} | @@ -159,9 +163,7 @@ {'state_timeout', % Set the state_timeout option Time :: state_timeout(), EventContent :: term(), - Options :: (timeout_option() | [timeout_option()])} | - %% - reply_action(). + Options :: (timeout_option() | [timeout_option()])}. -type reply_action() :: {'reply', % Reply to a caller From :: from(), Reply :: term()}. @@ -320,7 +322,13 @@ handle_event/4 % For callback_mode() =:= handle_event_function ]). + + %% Type validation functions +-compile( + {inline, + [callback_mode/1, state_enter/1, from/1, event_type/1]}). +%% callback_mode(CallbackMode) -> case CallbackMode of state_functions -> true; @@ -328,6 +336,14 @@ callback_mode(CallbackMode) -> _ -> false end. %% +state_enter(StateEnter) -> + case StateEnter of + state_enter -> + true; + _ -> + false + end. +%% from({Pid,_}) when is_pid(Pid) -> true; from(_) -> false. %% @@ -351,6 +367,48 @@ event_type(Type) -> STACKTRACE(), try throw(ok) catch _ -> erlang:get_stacktrace() end). +-define(not_sys_debug, []). +%% +%% This is a macro to only evaluate arguments if Debug =/= []. +%% Debug is evaluated multiple times. +-define( + sys_debug(Debug, NameState, Entry), + case begin Debug end of + ?not_sys_debug -> + begin Debug end; + _ -> + sys_debug(begin Debug end, begin NameState end, begin Entry end) + end). + +-record(state, + {callback_mode = undefined :: callback_mode() | undefined, + state_enter = false :: boolean(), + module :: atom(), + name :: atom(), + state :: term(), + data :: term(), + postponed = [] :: [{event_type(),term()}], + %% + timer_refs = #{} :: % timer ref => the timer's event type + #{reference() => timeout_event_type()}, + timer_types = #{} :: % timer's event type => timer ref + #{timeout_event_type() => reference()}, + cancel_timers = 0 :: non_neg_integer(), + %% We add a timer to both timer_refs and timer_types + %% when we start it. When we request an asynchronous + %% timer cancel we remove it from timer_types. When + %% the timer cancel message arrives we remove it from + %% timer_refs. + %% + hibernate = false :: boolean(), + hibernate_after = infinity :: timeout()}). + +-record(trans_opts, + {hibernate = false, + postpone = false, + timeouts_r = [], + next_events_r = []}). + %%%========================================================================== %%% API @@ -422,6 +480,10 @@ stop(ServerRef, Reason, Timeout) -> %% Send an event to a state machine that arrives with type 'event' -spec cast(ServerRef :: server_ref(), Msg :: term()) -> ok. +cast(ServerRef, Msg) when is_pid(ServerRef) -> + send(ServerRef, wrap_cast(Msg)); +cast(ServerRef, Msg) when is_atom(ServerRef) -> + send(ServerRef, wrap_cast(Msg)); cast({global,Name}, Msg) -> try global:send(Name, wrap_cast(Msg)) of _ -> ok @@ -435,10 +497,6 @@ cast({via,RegMod,Name}, Msg) -> _:_ -> ok end; cast({Name,Node} = ServerRef, Msg) when is_atom(Name), is_atom(Node) -> - send(ServerRef, wrap_cast(Msg)); -cast(ServerRef, Msg) when is_atom(ServerRef) -> - send(ServerRef, wrap_cast(Msg)); -cast(ServerRef, Msg) when is_pid(ServerRef) -> send(ServerRef, wrap_cast(Msg)). %% Call a state machine (synchronous; a reply is expected) that @@ -455,73 +513,16 @@ call(ServerRef, Request) -> {'clean_timeout',T :: timeout()} | {'dirty_timeout',T :: timeout()}) -> Reply :: term(). +call(ServerRef, Request, infinity = T = Timeout) -> + call_dirty(ServerRef, Request, Timeout, T); +call(ServerRef, Request, {dirty_timeout, T} = Timeout) -> + call_dirty(ServerRef, Request, Timeout, T); +call(ServerRef, Request, {clean_timeout, T} = Timeout) -> + call_clean(ServerRef, Request, Timeout, T); +call(ServerRef, Request, {_, _} = Timeout) -> + erlang:error(badarg, [ServerRef,Request,Timeout]); call(ServerRef, Request, Timeout) -> - case parse_timeout(Timeout) of - {dirty_timeout,T} -> - try gen:call(ServerRef, '$gen_call', Request, T) of - {ok,Reply} -> - Reply - catch - Class:Reason -> - erlang:raise( - Class, - {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, - erlang:get_stacktrace()) - end; - {clean_timeout,T} -> - %% Call server through proxy process to dodge any late reply - Ref = make_ref(), - Self = self(), - Pid = spawn( - fun () -> - Self ! - try gen:call( - ServerRef, '$gen_call', Request, T) of - Result -> - {Ref,Result} - catch Class:Reason -> - {Ref,Class,Reason, - erlang:get_stacktrace()} - end - end), - Mref = monitor(process, Pid), - receive - {Ref,Result} -> - demonitor(Mref, [flush]), - case Result of - {ok,Reply} -> - Reply - end; - {Ref,Class,Reason,Stacktrace} -> - demonitor(Mref, [flush]), - erlang:raise( - Class, - {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, - Stacktrace); - {'DOWN',Mref,_,_,Reason} -> - %% There is a theoretical possibility that the - %% proxy process gets killed between try--of and ! - %% so this clause is in case of that - exit(Reason) - end; - Error when is_atom(Error) -> - erlang:error(Error, [ServerRef,Request,Timeout]) - end. - -parse_timeout(Timeout) -> - case Timeout of - {clean_timeout,_} -> - Timeout; - {dirty_timeout,_} -> - Timeout; - {_,_} -> - %% Be nice and throw a badarg for speling errors - badarg; - infinity -> - {dirty_timeout,infinity}; - T -> - {clean_timeout,T} - end. + call_clean(ServerRef, Request, Timeout, Timeout). %% Reply from a state machine callback to whom awaits in call/2 -spec reply([reply_action()] | reply_action()) -> ok. @@ -530,6 +531,7 @@ reply({reply,From,Reply}) -> reply(Replies) when is_list(Replies) -> replies(Replies). %% +-compile({inline, [reply/2]}). -spec reply(From :: from(), Reply :: term()) -> ok. reply({To,Tag}, Reply) when is_pid(To) -> Msg = {Tag,Reply}, @@ -579,9 +581,59 @@ enter_loop(Module, Opts, State, Data, Server, Actions) -> %%--------------------------------------------------------------------------- %% API helpers +-compile({inline, [wrap_cast/1]}). wrap_cast(Event) -> {'$gen_cast',Event}. +call_dirty(ServerRef, Request, Timeout, T) -> + try gen:call(ServerRef, '$gen_call', Request, T) of + {ok,Reply} -> + Reply + catch + Class:Reason -> + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + erlang:get_stacktrace()) + end. + +call_clean(ServerRef, Request, Timeout, T) -> + %% Call server through proxy process to dodge any late reply + Ref = make_ref(), + Self = self(), + Pid = spawn( + fun () -> + Self ! + try gen:call( + ServerRef, '$gen_call', Request, T) of + Result -> + {Ref,Result} + catch Class:Reason -> + {Ref,Class,Reason, + erlang:get_stacktrace()} + end + end), + Mref = monitor(process, Pid), + receive + {Ref,Result} -> + demonitor(Mref, [flush]), + case Result of + {ok,Reply} -> + Reply + end; + {Ref,Class,Reason,Stacktrace} -> + demonitor(Mref, [flush]), + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + Stacktrace); + {'DOWN',Mref,_,_,Reason} -> + %% There is a theoretical possibility that the + %% proxy process gets killed between try--of and ! + %% so this clause is in case of that + exit(Reason) + end. + replies([{reply,From,Reply}|Replies]) -> reply(From, Reply), replies(Replies); @@ -606,60 +658,28 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) -> %% The values should already have been type checked Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), - HibernateAfterTimeout = gen:hibernate_after(Opts), - Events = [], - P = [], + HibernateAfterTimeout = gen:hibernate_after(Opts), + Events = [], Event = {internal,init_state}, %% We enforce {postpone,false} to ensure that %% our fake Event gets discarded, thought it might get logged - NewActions = - if - is_list(Actions) -> - Actions ++ [{postpone,false}]; - true -> - [Actions,{postpone,false}] - end, - TimerRefs = #{}, - %% Key: timer ref - %% Value: the timer type i.e the timer's event type - %% - TimerTypes = #{}, - %% Key: timer type i.e the timer's event type - %% Value: timer ref - %% - %% We add a timer to both timer_refs and timer_types - %% when we start it. When we request an asynchronous - %% timer cancel we remove it from timer_types. When - %% the timer cancel message arrives we remove it from - %% timer_refs. - %% - Hibernate = false, - CancelTimers = 0, - S = #{ - callback_mode => undefined, - state_enter => false, - module => Module, - name => Name, - state => State, - data => Data, - postponed => P, - %% - %% The following fields are finally set from to the arguments to - %% loop_event_actions/9 when it finally loops back to loop/3 - %% in loop_event_result/11 - timer_refs => TimerRefs, - timer_types => TimerTypes, - hibernate => Hibernate, - hibernate_after => HibernateAfterTimeout, - cancel_timers => CancelTimers - }, - NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), + NewActions = listify(Actions) ++ [{postpone,false}], + S = + #state{ + module = Module, + name = Name, + state = State, + data = Data, + hibernate_after = HibernateAfterTimeout}, + CallEnter = true, + NewDebug = ?sys_debug(Debug, {Name,State}, {enter,Event,State}), case call_callback_mode(S) of - {ok,NewS} -> + #state{} = NewS -> loop_event_actions( Parent, NewDebug, NewS, - Events, Event, State, Data, NewActions, true); - {Class,Reason,Stacktrace} -> + Events, Event, State, Data, #trans_opts{}, + NewActions, CallEnter); + [Class,Reason,Stacktrace] -> terminate( Class, Reason, Stacktrace, NewDebug, S, [Event|Events]) @@ -684,10 +704,8 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> proc_lib:init_ack(Starter, {error,Reason}), error_info( Class, Reason, Stacktrace, - #{name => Name, - callback_mode => undefined, - state_enter => false}, - [], [], undefined), + #state{name = Name}, + [], undefined), erlang:raise(Class, Reason, Stacktrace) end. @@ -717,10 +735,8 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> proc_lib:init_ack(Starter, {error,Error}), error_info( error, Error, ?STACKTRACE(), - #{name => Name, - callback_mode => undefined, - state_enter => false}, - [], [], undefined), + #state{name = Name}, + [], undefined), exit(Error) end. @@ -734,9 +750,10 @@ system_terminate(Reason, _Parent, Debug, S) -> terminate(exit, Reason, ?STACKTRACE(), Debug, S, []). system_code_change( - #{module := Module, - state := State, - data := Data} = S, + #state{ + module = Module, + state = State, + data = Data} = S, _Mod, OldVsn, Extra) -> case try Module:code_change(OldVsn, State, Data, Extra) @@ -746,29 +763,31 @@ system_code_change( of {ok,NewState,NewData} -> {ok, - S#{callback_mode := undefined, - state := NewState, - data := NewData}}; + S#state{ + callback_mode = undefined, + state = NewState, + data = NewData}}; {ok,_} = Error -> error({case_clause,Error}); Error -> Error end. -system_get_state(#{state := State, data := Data}) -> +system_get_state(#state{state = State, data = Data}) -> {ok,{State,Data}}. system_replace_state( StateFun, - #{state := State, - data := Data} = S) -> + #state{ + state = State, + data = Data} = S) -> {NewState,NewData} = Result = StateFun({State,Data}), - {ok,Result,S#{state := NewState, data := NewData}}. + {ok,Result,S#state{state = NewState, data = NewData}}. format_status( Opt, [PDict,SysState,Parent,Debug, - #{name := Name, postponed := P} = S]) -> + #state{name = Name, postponed = P} = S]) -> Header = gen:format_status_header("Status for state machine", Name), Log = sys:get_debug(log, Debug, []), [{header,Header}, @@ -787,6 +806,9 @@ format_status( %% them, not as the real erlang messages. Use trace for that. %%--------------------------------------------------------------------------- +sys_debug(Debug, NameState, Entry) -> + sys:handle_debug(Debug, fun print_event/3, NameState, Entry). + print_event(Dev, {in,Event}, {Name,State}) -> io:format( Dev, "*DBG* ~tp receive ~ts in state ~tp~n", @@ -819,15 +841,6 @@ event_string(Event) -> io_lib:format("~tw ~tp", [EventType,EventContent]) end. -sys_debug(Debug, #{name := Name}, State, Entry) -> - case Debug of - [] -> - Debug; - _ -> - sys:handle_debug( - Debug, fun print_event/3, {Name,State}, Entry) - end. - %%%========================================================================== %%% Internal callbacks @@ -842,14 +855,16 @@ wakeup_from_hibernate(Parent, Debug, S) -> %% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3 %% Entry point for system_continue/3 -loop(Parent, Debug, #{hibernate := true, cancel_timers := 0} = S) -> +loop(Parent, Debug, #state{hibernate = true, cancel_timers = 0} = S) -> loop_hibernate(Parent, Debug, S); loop(Parent, Debug, S) -> loop_receive(Parent, Debug, S). loop_hibernate(Parent, Debug, S) -> + %% %% Does not return but restarts process at %% wakeup_from_hibernate/3 that jumps to loop_receive/3 + %% proc_lib:hibernate( ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]), error( @@ -857,17 +872,18 @@ loop_hibernate(Parent, Debug, S) -> {wakeup_from_hibernate,3}}). %% Entry point for wakeup_from_hibernate/3 -loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> +loop_receive( + Parent, Debug, #state{hibernate_after = HibernateAfterTimeout} = S) -> + %% receive Msg -> case Msg of {system,Pid,Req} -> - #{hibernate := Hibernate} = S, %% Does not return but tail recursively calls %% system_continue/3 that jumps to loop/3 sys:handle_system_msg( Req, Pid, Parent, ?MODULE, Debug, S, - Hibernate); + S#state.hibernate); {'EXIT',Parent,Reason} = EXIT -> %% EXIT is not a 2-tuple therefore %% not an event but this will stand out @@ -875,9 +891,9 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> Q = [EXIT], terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q); {timeout,TimerRef,TimerMsg} -> - #{timer_refs := TimerRefs, - timer_types := TimerTypes, - hibernate := Hibernate} = S, + #state{ + timer_refs = TimerRefs, + timer_types = TimerTypes} = S, case TimerRefs of #{TimerRef := TimerType} -> %% We know of this timer; is it a running @@ -887,7 +903,6 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> #{TimerType := TimerRef} -> %% The timer type maps back to this %% timer ref, so it was a running timer - Event = {TimerType,TimerMsg}, %% Unregister the triggered timeout NewTimerRefs = maps:remove(TimerRef, TimerRefs), @@ -895,11 +910,10 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> maps:remove(TimerType, TimerTypes), loop_receive_result( Parent, Debug, - S#{ - timer_refs := NewTimerRefs, - timer_types := NewTimerTypes}, - Hibernate, - Event); + S#state{ + timer_refs = NewTimerRefs, + timer_types = NewTimerTypes}, + TimerType, TimerMsg); _ -> %% This was a late timeout message %% from timer being cancelled, so @@ -909,14 +923,13 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> end; _ -> %% Not our timer; present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) + loop_receive_result(Parent, Debug, S, info, Msg) end; {cancel_timer,TimerRef,_} -> - #{timer_refs := TimerRefs, - cancel_timers := CancelTimers, - hibernate := Hibernate} = S, + #state{ + timer_refs = TimerRefs, + cancel_timers = CancelTimers, + hibernate = Hibernate} = S, case TimerRefs of #{TimerRef := _} -> %% We must have requested a cancel @@ -926,9 +939,9 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> maps:remove(TimerRef, TimerRefs), NewCancelTimers = CancelTimers - 1, NewS = - S#{ - timer_refs := NewTimerRefs, - cancel_timers := NewCancelTimers}, + S#state{ + timer_refs = NewTimerRefs, + cancel_timers = NewCancelTimers}, if Hibernate =:= true, NewCancelTimers =:= 0 -> %% No more cancel_timer msgs to expect; @@ -940,238 +953,631 @@ loop_receive(Parent, Debug, #{hibernate_after := HibernateAfterTimeout} = S) -> _ -> %% Not our cancel_timer msg; %% present it as an event - Event = {info,Msg}, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) + loop_receive_result(Parent, Debug, S, info, Msg) end; _ -> %% External msg - #{hibernate := Hibernate} = S, - Event = - case Msg of - {'$gen_call',From,Request} -> - {{call,From},Request}; - {'$gen_cast',E} -> - {cast,E}; - _ -> - {info,Msg} - end, - loop_receive_result( - Parent, Debug, S, Hibernate, Event) + case Msg of + {'$gen_call',From,Request} -> + loop_receive_result( + Parent, Debug, S, {call,From}, Request); + {'$gen_cast',Cast} -> + loop_receive_result(Parent, Debug, S, cast, Cast); + _ -> + loop_receive_result(Parent, Debug, S, info, Msg) + end end after HibernateAfterTimeout -> loop_hibernate(Parent, Debug, S) end. +loop_receive_result(Parent, ?not_sys_debug, S, Type, Content) -> + %% Here is the queue of not yet handled events created + Events = [], + loop_event(Parent, ?not_sys_debug, S, Events, Type, Content); loop_receive_result( - Parent, Debug, - #{state := State, - timer_types := TimerTypes, cancel_timers := CancelTimers} = S, - Hibernate, Event) -> - %% From now the 'hibernate' field in S is invalid - %% and will be restored when looping back - %% in loop_event_result/11 - NewDebug = sys_debug(Debug, S, State, {in,Event}), + Parent, Debug, #state{name = Name, state = State} = S, Type, Content) -> + NewDebug = sys_debug(Debug, {Name,State}, {in,{Type,Content}}), %% Here is the queue of not yet handled events created Events = [], - %% Cancel any running event timer - case - cancel_timer_by_type(timeout, TimerTypes, CancelTimers) - of - {_,CancelTimers} -> - %% No timer cancelled - loop_event(Parent, NewDebug, S, Events, Event, Hibernate); - {NewTimerTypes,NewCancelTimers} -> - %% The timer is removed from NewTimerTypes but - %% remains in TimerRefs until we get - %% the cancel_timer msg - NewS = - S#{ - timer_types := NewTimerTypes, - cancel_timers := NewCancelTimers}, - loop_event(Parent, NewDebug, NewS, Events, Event, Hibernate) - end. + loop_event(Parent, NewDebug, S, Events, Type, Content). %% Entry point for handling an event, received or enqueued loop_event( + Parent, Debug, #state{hibernate = Hibernate} = S, + Events, Type, Content) -> + %% + case Hibernate of + true -> + %% + %% If (this old) Hibernate is true here it can only be + %% because it was set from an event action + %% and we did not go into hibernation since there were + %% events in queue, so we do what the user + %% might rely on i.e collect garbage which + %% would have happened if we actually hibernated + %% and immediately was awakened. + %% + _ = garbage_collect(), + loop_event_state_function( + Parent, Debug, S, Events, Type, Content); + false -> + loop_event_state_function( + Parent, Debug, S, Events, Type, Content) + end. + +%% Call the state function +loop_event_state_function( Parent, Debug, - #{state := State, data := Data} = S, - Events, {Type,Content} = Event, Hibernate) -> + #state{state = State, data = Data} = S, + Events, Type, Content) -> + %% + %% The field 'hibernate' in S is now invalid and will be + %% restored when looping back to loop/3 or loop_event/6. %% - %% If (this old) Hibernate is true here it can only be - %% because it was set from an event action - %% and we did not go into hibernation since there were - %% events in queue, so we do what the user - %% might rely on i.e collect garbage which - %% would have happened if we actually hibernated - %% and immediately was awakened - Hibernate andalso garbage_collect(), + Event = {Type,Content}, + TransOpts = false, case call_state_function(S, Type, Content, State, Data) of - {ok,Result,NewS} -> - {NextState,NewData,Actions,EnterCall} = - parse_event_result( - true, Debug, NewS, - Events, Event, State, Data, Result), - loop_event_actions( - Parent, Debug, NewS, - Events, Event, NextState, NewData, Actions, EnterCall); - {Class,Reason,Stacktrace} -> + {Result, NewS} -> + loop_event_result( + Parent, Debug, NewS, + Events, Event, State, Data, TransOpts, Result); + [Class,Reason,Stacktrace] -> terminate( - Class, Reason, Stacktrace, Debug, S, - [Event|Events]) + Class, Reason, Stacktrace, Debug, S, [Event|Events]) end. -loop_event_actions( - Parent, Debug, - #{state := State, state_enter := StateEnter} = S, - Events, Event, NextState, NewData, - Actions, EnterCall) -> - %% Hibernate is reborn here as false being - %% the default value from parse_actions/4 - case parse_actions(Debug, S, State, Actions) of - {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} -> - if - StateEnter, EnterCall -> - loop_event_enter( - Parent, NewDebug, S, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR); - true -> - loop_event_result( - Parent, NewDebug, S, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR) - end; - {Class,Reason,Stacktrace} -> +%% Make a state enter call to the state function +loop_event_state_enter( + Parent, Debug, #state{state = PrevState} = S, + Events, Event, NextState, NewData, TransOpts) -> + %% + case call_state_function(S, enter, PrevState, NextState, NewData) of + {Result, NewS} -> + loop_event_result( + Parent, Debug, NewS, + Events, Event, NextState, NewData, TransOpts, Result); + [Class,Reason,Stacktrace] -> terminate( - Class, Reason, Stacktrace, Debug, S, - [Event|Events]) + Class, Reason, Stacktrace, Debug, S, [Event|Events]) end. -loop_event_enter( - Parent, Debug, #{state := State} = S, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR) -> - case call_state_function(S, enter, State, NextState, NewData) of - {ok,Result,NewS} -> - case parse_event_result( - false, Debug, NewS, - Events, Event, NextState, NewData, Result) of - {_,NewerData,Actions,EnterCall} -> - loop_event_enter_actions( - Parent, Debug, NewS, - Events, Event, NextState, NewerData, - Hibernate, TimeoutsR, Postpone, NextEventsR, - Actions, EnterCall) - end; - {Class,Reason,Stacktrace} -> - terminate( - Class, Reason, Stacktrace, Debug, - S#{ - state := NextState, - data := NewData, - hibernate := Hibernate}, - [Event|Events]) +%% Process the result from the state function. +%% When TransOpts =:= false it was a state function call, +%% otherwise it is an option tuple and it was a state enter call. +%% +loop_event_result( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, Result) -> + %% + case Result of + {next_state,State,NewData} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + [], false); + {next_state,NextState,NewData} + when TransOpts =:= false -> + loop_event_actions( + Parent, Debug, S, + Events, Event, NextState, NewData, TransOpts, + [], true); + {next_state,State,NewData,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + Actions, false); + {next_state,NextState,NewData,Actions} + when TransOpts =:= false -> + loop_event_actions( + Parent, Debug, S, + Events, Event, NextState, NewData, TransOpts, + Actions, true); + %% + {keep_state,NewData} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + [], false); + {keep_state,NewData,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + Actions, false); + %% + keep_state_and_data -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, + [], false); + {keep_state_and_data,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, + Actions, false); + %% + {repeat_state,NewData} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + [], true); + {repeat_state,NewData,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, NewData, TransOpts, + Actions, true); + %% + repeat_state_and_data -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, + [], true); + {repeat_state_and_data,Actions} -> + loop_event_actions( + Parent, Debug, S, + Events, Event, State, Data, TransOpts, + Actions, true); + %% + stop -> + terminate( + exit, normal, ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]); + {stop,Reason} -> + terminate( + exit, Reason, ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]); + {stop,Reason,NewData} -> + terminate( + exit, Reason, ?STACKTRACE(), Debug, + S#state{ + state = State, data = NewData, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]); + %% + {stop_and_reply,Reason,Replies} -> + reply_then_terminate( + exit, Reason, ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events], Replies); + {stop_and_reply,Reason,Replies,NewData} -> + reply_then_terminate( + exit, Reason, ?STACKTRACE(), Debug, + S#state{ + state = State, data = NewData, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events], Replies); + %% + _ -> + terminate( + error, + {bad_return_from_state_function,Result}, + ?STACKTRACE(), Debug, + S#state{ + state = State, data = Data, + hibernate = hibernate_in_trans_opts(TransOpts)}, + [Event|Events]) end. -loop_event_enter_actions( - Parent, Debug, #{state_enter := StateEnter} = S, - Events, Event, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR, - Actions, EnterCall) -> - case - parse_enter_actions( - Debug, S, NextState, Actions, Hibernate, TimeoutsR) - of - {ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} -> - if - StateEnter, EnterCall -> - loop_event_enter( - Parent, NewDebug, S, - Events, Event, NextState, NewData, - NewHibernate, NewTimeoutsR, Postpone, NextEventsR); - true -> - loop_event_result( - Parent, NewDebug, S, - Events, Event, NextState, NewData, - NewHibernate, NewTimeoutsR, Postpone, NextEventsR) - end; - {Class,Reason,Stacktrace} -> - terminate( - Class, Reason, Stacktrace, Debug, - S#{ - state := NextState, - data := NewData, - hibernate := Hibernate}, - [Event|Events]) +-compile({inline, [hibernate_in_trans_opts/1]}). +hibernate_in_trans_opts(false) -> + (#trans_opts{})#trans_opts.hibernate; +hibernate_in_trans_opts(#trans_opts{hibernate = Hibernate}) -> + Hibernate. + +%% Ensure that Actions are a list +loop_event_actions( + Parent, Debug, S, + Events, Event, NextState, NewerData, TransOpts, + Actions, CallEnter) -> + loop_event_actions_list( + Parent, Debug, S, + Events, Event, NextState, NewerData, TransOpts, + listify(Actions), CallEnter). + +%% Process actions from the state function +loop_event_actions_list( + Parent, Debug, #state{state_enter = StateEnter} = S, + Events, Event, NextState, NewerData, TransOpts, + Actions, CallEnter) -> + %% + case parse_actions(TransOpts, Debug, S, Actions) of + {NewDebug,NewTransOpts} + when StateEnter, CallEnter -> + loop_event_state_enter( + Parent, NewDebug, S, + Events, Event, NextState, NewerData, NewTransOpts); + {NewDebug,NewTransOpts} -> + loop_event_done( + Parent, NewDebug, S, + Events, Event, NextState, NewerData, NewTransOpts); + [Class,Reason,Stacktrace,NewDebug] -> + terminate( + Class, Reason, Stacktrace, NewDebug, + S#state{ + state = NextState, + data = NewerData, + hibernate = TransOpts#trans_opts.hibernate}, + [Event|Events]) end. -loop_event_result( +parse_actions(false, Debug, S, Actions) -> + parse_actions(true, Debug, S, Actions, #trans_opts{}); +parse_actions(TransOpts, Debug, S, Actions) -> + parse_actions(false, Debug, S, Actions, TransOpts). +%% +parse_actions(_StateCall, Debug, _S, [], TransOpts) -> + {Debug,TransOpts}; +parse_actions(StateCall, Debug, S, [Action|Actions], TransOpts) -> + case Action of + %% Actual actions + {reply,From,Reply} -> + parse_actions_reply( + StateCall, Debug, S, Actions, TransOpts, From, Reply); + %% + %% Actions that set options + {hibernate,NewHibernate} when is_boolean(NewHibernate) -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{hibernate = NewHibernate}); + hibernate -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{hibernate = true}); + %% + {postpone,NewPostpone} when not NewPostpone orelse StateCall -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{postpone = NewPostpone}); + postpone when StateCall -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{postpone = true}); + %% + {next_event,Type,Content} -> + parse_actions_next_event( + StateCall, Debug, S, Actions, TransOpts, Type, Content); + %% + _ -> + parse_actions_timeout( + StateCall, Debug, S, Actions, TransOpts, Action) + end. + +parse_actions_reply( + StateCall, ?not_sys_debug, S, Actions, TransOpts, + From, Reply) -> + %% + case from(From) of + true -> + reply(From, Reply), + parse_actions(StateCall, ?not_sys_debug, S, Actions, TransOpts); + false -> + [error, + {bad_action_from_state_function,{reply,From,Reply}}, + ?STACKTRACE(), + ?not_sys_debug] + end; +parse_actions_reply( + StateCall, Debug, #state{name = Name, state = State} = S, + Actions, TransOpts, From, Reply) -> + %% + case from(From) of + true -> + reply(From, Reply), + NewDebug = sys_debug(Debug, {Name,State}, {out,Reply,From}), + parse_actions(StateCall, NewDebug, S, Actions, TransOpts); + false -> + [error, + {bad_action_from_state_function,{reply,From,Reply}}, + ?STACKTRACE(), + Debug] + end. + +parse_actions_next_event( + StateCall, ?not_sys_debug, S, + Actions, TransOpts, Type, Content) -> + case event_type(Type) of + true when StateCall -> + NextEventsR = TransOpts#trans_opts.next_events_r, + parse_actions( + StateCall, ?not_sys_debug, S, Actions, + TransOpts#trans_opts{ + next_events_r = [{Type,Content}|NextEventsR]}); + _ -> + [error, + {bad_action_from_state_function,{next_events,Type,Content}}, + ?STACKTRACE(), + ?not_sys_debug] + end; +parse_actions_next_event( + StateCall, Debug, #state{name = Name, state = State} = S, + Actions, TransOpts, Type, Content) -> + case event_type(Type) of + true when StateCall -> + NewDebug = sys_debug(Debug, {Name,State}, {in,{Type,Content}}), + NextEventsR = TransOpts#trans_opts.next_events_r, + parse_actions( + StateCall, NewDebug, S, Actions, + TransOpts#trans_opts{ + next_events_r = [{Type,Content}|NextEventsR]}); + _ -> + [error, + {bad_action_from_state_function,{next_events,Type,Content}}, + ?STACKTRACE(), + Debug] + end. + +parse_actions_timeout( + StateCall, Debug, S, Actions, TransOpts, + {TimerType,Time,TimerMsg,TimerOpts} = AbsoluteTimeout) -> + %% + case classify_timer(Time, listify(TimerOpts)) of + absolute -> + parse_actions_timeout_add( + StateCall, Debug, S, Actions, + TransOpts, AbsoluteTimeout); + relative -> + RelativeTimeout = {TimerType,Time,TimerMsg}, + parse_actions_timeout_add( + StateCall, Debug, S, Actions, + TransOpts, RelativeTimeout); + badarg -> + [error, + {bad_action_from_state_function,AbsoluteTimeout}, + ?STACKTRACE(), + Debug] + end; +parse_actions_timeout( + StateCall, Debug, S, Actions, TransOpts, + {_,Time,_} = RelativeTimeout) -> + case classify_timer(Time, []) of + relative -> + parse_actions_timeout_add( + StateCall, Debug, S, Actions, + TransOpts, RelativeTimeout); + badarg -> + [error, + {bad_action_from_state_function,RelativeTimeout}, + ?STACKTRACE(), + Debug] + end; +parse_actions_timeout( + StateCall, Debug, S, Actions, TransOpts, + Timeout) -> + case classify_timer(Timeout, []) of + relative -> + parse_actions_timeout_add( + StateCall, Debug, S, Actions, TransOpts, Timeout); + badarg -> + [error, + {bad_action_from_state_function,Timeout}, + ?STACKTRACE(), + Debug] + end. + +parse_actions_timeout_add( + StateCall, Debug, S, Actions, + #trans_opts{timeouts_r = TimeoutsR} = TransOpts, Timeout) -> + parse_actions( + StateCall, Debug, S, Actions, + TransOpts#trans_opts{timeouts_r = [Timeout|TimeoutsR]}). + +%% Do the state transition +loop_event_done( + Parent, ?not_sys_debug, + #state{postponed = P} = S, + Events, Event, NextState, NewData, + #trans_opts{ + postpone = Postpone, hibernate = Hibernate, + timeouts_r = [], next_events_r = []}) -> + %% + %% Optimize the simple cases + %% i.e no timer changes, no inserted events and no debug, + %% by duplicate stripped down code + %% + %% Fast path + %% + case Postpone of + true -> + loop_event_done_fast( + Parent, Hibernate, + S, + Events, [Event|P], NextState, NewData); + false -> + loop_event_done_fast( + Parent, Hibernate, + S, + Events, P, NextState, NewData) + end; +loop_event_done( Parent, Debug_0, - #{state := State, postponed := P_0, - timer_refs := TimerRefs_0, timer_types := TimerTypes_0, - cancel_timers := CancelTimers_0} = S_0, + #state{ + state = State, postponed = P_0, + timer_refs = TimerRefs_0, timer_types = TimerTypes_0, + cancel_timers = CancelTimers_0} = S, Events_0, Event_0, NextState, NewData, - Hibernate, TimeoutsR, Postpone, NextEventsR) -> + #trans_opts{ + hibernate = Hibernate, timeouts_r = TimeoutsR, + postpone = Postpone, next_events_r = NextEventsR}) -> %% %% All options have been collected and next_events are buffered. %% Do the actual state transition. %% - {Debug_1,P_1} = % Move current event to postponed if Postpone + %% Full feature path + %% + [Debug_1|P_1] = % Move current event to postponed if Postpone case Postpone of true -> - {sys_debug(Debug_0, S_0, State, {postpone,Event_0,State}), - [Event_0|P_0]}; + [?sys_debug( + Debug_0, + {S#state.name,State}, + {postpone,Event_0,State}), + Event_0|P_0]; false -> - {sys_debug(Debug_0, S_0, State, {consume,Event_0,State}), - P_0} + [?sys_debug( + Debug_0, + {S#state.name,State}, + {consume,Event_0,State})|P_0] end, - {Events_1,P_2,{TimerTypes_1,CancelTimers_1}} = - %% Move all postponed events to queue and cancel the - %% state timeout if the state changes + {Events_2,P_2,Timers_2} = + %% Move all postponed events to queue, + %% cancel the event timer, + %% and cancel the state timeout if the state changes if NextState =:= State -> - {Events_0,P_1,{TimerTypes_0,CancelTimers_0}}; + {Events_0,P_1, + cancel_timer_by_type( + timeout, {TimerTypes_0,CancelTimers_0})}; true -> {lists:reverse(P_1, Events_0), [], cancel_timer_by_type( - state_timeout, TimerTypes_0, CancelTimers_0)} - %% The state timer is removed from TimerTypes_1 - %% but remains in TimerRefs_0 until we get + state_timeout, + cancel_timer_by_type( + timeout, {TimerTypes_0,CancelTimers_0}))} + %% The state timer is removed from TimerTypes + %% but remains in TimerRefs until we get %% the cancel_timer msg end, - {TimerRefs_2,TimerTypes_2,CancelTimers_2,TimeoutEvents} = - %% Stop and start non-event timers - parse_timers(TimerRefs_0, TimerTypes_1, CancelTimers_1, TimeoutsR), + {TimerRefs_3,{TimerTypes_3,CancelTimers_3},TimeoutEvents} = + %% Stop and start timers + parse_timers(TimerRefs_0, Timers_2, TimeoutsR), %% Place next events last in reversed queue - Events_2R = lists:reverse(Events_1, NextEventsR), - %% Enqueue immediate timeout events and start event timer - Events_3R = prepend_timeout_events(TimeoutEvents, Events_2R), - S_1 = - S_0#{ - state := NextState, - data := NewData, - postponed := P_2, - timer_refs := TimerRefs_2, - timer_types := TimerTypes_2, - cancel_timers := CancelTimers_2, - hibernate := Hibernate}, - case lists:reverse(Events_3R) of - [] -> - %% Get a new event - loop(Parent, Debug_1, S_1); - [Event|Events] -> + Events_3R = lists:reverse(Events_2, NextEventsR), + %% Enqueue immediate timeout events + Events_4R = prepend_timeout_events(TimeoutEvents, Events_3R), + loop_event_done( + Parent, Debug_1, + S#state{ + state = NextState, + data = NewData, + postponed = P_2, + timer_refs = TimerRefs_3, + timer_types = TimerTypes_3, + cancel_timers = CancelTimers_3, + hibernate = Hibernate}, + lists:reverse(Events_4R)). + +%% Fast path +%% +loop_event_done_fast( + Parent, Hibernate, + #state{ + state = NextState, + timer_types = #{timeout := _} = TimerTypes, + cancel_timers = CancelTimers} = S, + Events, P, NextState, NewData) -> + %% + %% Same state, event timeout active + %% + loop_event_done_fast( + Parent, Hibernate, S, + Events, P, NextState, NewData, + cancel_timer_by_type( + timeout, {TimerTypes,CancelTimers})); +loop_event_done_fast( + Parent, Hibernate, + #state{state = NextState} = S, + Events, P, NextState, NewData) -> + %% + %% Same state + %% + loop_event_done( + Parent, ?not_sys_debug, + S#state{ + data = NewData, + postponed = P, + hibernate = Hibernate}, + Events); +loop_event_done_fast( + Parent, Hibernate, + #state{ + timer_types = #{timeout := _} = TimerTypes, + cancel_timers = CancelTimers} = S, + Events, P, NextState, NewData) -> + %% + %% State change, event timeout active + %% + loop_event_done_fast( + Parent, Hibernate, S, + lists:reverse(P, Events), [], NextState, NewData, + cancel_timer_by_type( + state_timeout, + cancel_timer_by_type( + timeout, {TimerTypes,CancelTimers}))); +loop_event_done_fast( + Parent, Hibernate, + #state{ + timer_types = #{state_timeout := _} = TimerTypes, + cancel_timers = CancelTimers} = S, + Events, P, NextState, NewData) -> + %% + %% State change, state timeout active + %% + loop_event_done_fast( + Parent, Hibernate, S, + lists:reverse(P, Events), [], NextState, NewData, + cancel_timer_by_type( + state_timeout, + cancel_timer_by_type( + timeout, {TimerTypes,CancelTimers}))); +loop_event_done_fast( + Parent, Hibernate, + #state{} = S, + Events, P, NextState, NewData) -> + %% + %% State change, no timeout to automatically cancel + %% + loop_event_done( + Parent, ?not_sys_debug, + S#state{ + state = NextState, + data = NewData, + postponed = [], + hibernate = Hibernate}, + lists:reverse(P, Events)). +%% +%% Fast path +%% +loop_event_done_fast( + Parent, Hibernate, S, + Events, P, NextState, NewData, + {TimerTypes,CancelTimers}) -> + %% + loop_event_done( + Parent, ?not_sys_debug, + S#state{ + state = NextState, + data = NewData, + postponed = P, + timer_types = TimerTypes, + cancel_timers = CancelTimers, + hibernate = Hibernate}, + Events). + +loop_event_done(Parent, Debug, S, Q) -> + case Q of + [] -> + %% Get a new event + loop(Parent, Debug, S); + [{Type,Content}|Events] -> %% Loop until out of enqueued events - loop_event(Parent, Debug_1, S_1, Events, Event, Hibernate) + loop_event(Parent, Debug, S, Events, Type, Content) end. %%--------------------------------------------------------------------------- %% Server loop helpers -call_callback_mode(#{module := Module} = S) -> +call_callback_mode(#state{module = Module} = S) -> try Module:callback_mode() of CallbackMode -> callback_mode_result(S, CallbackMode) @@ -1179,58 +1585,45 @@ call_callback_mode(#{module := Module} = S) -> CallbackMode -> callback_mode_result(S, CallbackMode); Class:Reason -> - {Class,Reason,erlang:get_stacktrace()} + [Class,Reason,erlang:get_stacktrace()] end. callback_mode_result(S, CallbackMode) -> - case - parse_callback_mode( - if - is_atom(CallbackMode) -> - [CallbackMode]; - true -> - CallbackMode - end, undefined, false) - of - {undefined,_} -> - {error, - {bad_return_from_callback_mode,CallbackMode}, - ?STACKTRACE()}; - {CBMode,StateEnter} -> - {ok, - S#{ - callback_mode := CBMode, - state_enter := StateEnter}} - end. - -parse_callback_mode([], CBMode, StateEnter) -> - {CBMode,StateEnter}; -parse_callback_mode([H|T], CBMode, StateEnter) -> + callback_mode_result( + S, CallbackMode, listify(CallbackMode), undefined, false). +%% +callback_mode_result(_S, CallbackMode, [], undefined, _StateEnter) -> + [error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE()]; +callback_mode_result(S, _CallbackMode, [], CBMode, StateEnter) -> + S#state{callback_mode = CBMode, state_enter = StateEnter}; +callback_mode_result(S, CallbackMode, [H|T], CBMode, StateEnter) -> case callback_mode(H) of true -> - parse_callback_mode(T, H, StateEnter); + callback_mode_result(S, CallbackMode, T, H, StateEnter); false -> - case H of - state_enter -> - parse_callback_mode(T, CBMode, true); - _ -> - {undefined,StateEnter} + case state_enter(H) of + true -> + callback_mode_result(S, CallbackMode, T, CBMode, true); + false -> + [error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE()] end - end; -parse_callback_mode(_, _CBMode, StateEnter) -> - {undefined,StateEnter}. + end. call_state_function( - #{callback_mode := undefined} = S, Type, Content, State, Data) -> + #state{callback_mode = undefined} = S, Type, Content, State, Data) -> case call_callback_mode(S) of - {ok,NewS} -> + #state{} = NewS -> call_state_function(NewS, Type, Content, State, Data); Error -> Error end; call_state_function( - #{callback_mode := CallbackMode, module := Module} = S, + #state{callback_mode = CallbackMode, module = Module} = S, Type, Content, State, Data) -> try case CallbackMode of @@ -1241,333 +1634,108 @@ call_state_function( end of Result -> - {ok,Result,S} + {Result,S} catch Result -> - {ok,Result,S}; + {Result,S}; Class:Reason -> - {Class,Reason,erlang:get_stacktrace()} - end. - - -%% Interpret all callback return variants -parse_event_result( - AllowStateChange, Debug, S, - Events, Event, State, Data, Result) -> - case Result of - stop -> - terminate( - exit, normal, ?STACKTRACE(), Debug, - S#{state := State, data := Data}, - [Event|Events]); - {stop,Reason} -> - terminate( - exit, Reason, ?STACKTRACE(), Debug, - S#{state := State, data := Data}, - [Event|Events]); - {stop,Reason,NewData} -> - terminate( - exit, Reason, ?STACKTRACE(), Debug, - S#{state := State, data := NewData}, - [Event|Events]); - %% - {stop_and_reply,Reason,Replies} -> - reply_then_terminate( - exit, Reason, ?STACKTRACE(), Debug, - S#{state := State, data := Data}, - [Event|Events], Replies); - {stop_and_reply,Reason,Replies,NewData} -> - reply_then_terminate( - exit, Reason, ?STACKTRACE(), Debug, - S#{state := State, data := NewData}, - [Event|Events], Replies); - %% - {next_state,State,NewData} -> - {State,NewData,[],false}; - {next_state,NextState,NewData} when AllowStateChange -> - {NextState,NewData,[],true}; - {next_state,State,NewData,Actions} -> - {State,NewData,Actions,false}; - {next_state,NextState,NewData,Actions} when AllowStateChange -> - {NextState,NewData,Actions,true}; - %% - {keep_state,NewData} -> - {State,NewData,[],false}; - {keep_state,NewData,Actions} -> - {State,NewData,Actions,false}; - keep_state_and_data -> - {State,Data,[],false}; - {keep_state_and_data,Actions} -> - {State,Data,Actions,false}; - %% - {repeat_state,NewData} -> - {State,NewData,[],true}; - {repeat_state,NewData,Actions} -> - {State,NewData,Actions,true}; - repeat_state_and_data -> - {State,Data,[],true}; - {repeat_state_and_data,Actions} -> - {State,Data,Actions,true}; - %% - _ -> - terminate( - error, - {bad_return_from_state_function,Result}, - ?STACKTRACE(), Debug, - S#{state := State, data := Data}, - [Event|Events]) - end. - - -parse_enter_actions(Debug, S, State, Actions, Hibernate, TimeoutsR) -> - Postpone = forbidden, - NextEventsR = forbidden, - parse_actions( - Debug, S, State, listify(Actions), - Hibernate, TimeoutsR, Postpone, NextEventsR). - -parse_actions(Debug, S, State, Actions) -> - Hibernate = false, - TimeoutsR = [infinity], %% Will cancel event timer - Postpone = false, - NextEventsR = [], - parse_actions( - Debug, S, State, listify(Actions), - Hibernate, TimeoutsR, Postpone, NextEventsR). -%% -parse_actions( - Debug, _S, _State, [], - Hibernate, TimeoutsR, Postpone, NextEventsR) -> - {ok,Debug,Hibernate,TimeoutsR,Postpone,NextEventsR}; -parse_actions( - Debug, S, State, [Action|Actions], - Hibernate, TimeoutsR, Postpone, NextEventsR) -> - case Action of - %% Actual actions - {reply,From,Reply} -> - case from(From) of - true -> - NewDebug = do_reply(Debug, S, State, From, Reply), - parse_actions( - NewDebug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR); - false -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()} - end; - %% - %% Actions that set options - {hibernate,NewHibernate} when is_boolean(NewHibernate) -> - parse_actions( - Debug, S, State, Actions, - NewHibernate, TimeoutsR, Postpone, NextEventsR); - hibernate -> - NewHibernate = true, - parse_actions( - Debug, S, State, Actions, - NewHibernate, TimeoutsR, Postpone, NextEventsR); - %% - {postpone,NewPostpone} - when is_boolean(NewPostpone), Postpone =/= forbidden -> - parse_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR, NewPostpone, NextEventsR); - postpone when Postpone =/= forbidden -> - NewPostpone = true, - parse_actions( - Debug, S, State, Actions, - Hibernate, TimeoutsR, NewPostpone, NextEventsR); - %% - {next_event,Type,Content} -> - case event_type(Type) of - true when NextEventsR =/= forbidden -> - NewDebug = - sys_debug(Debug, S, State, {in,{Type,Content}}), - parse_actions( - NewDebug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, - [{Type,Content}|NextEventsR]); - _ -> - {error, - {bad_action_from_state_function,Action}, - ?STACKTRACE()} - end; - %% - {{timeout,_},_,_} = Timeout -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - {{timeout,_},_,_,_} = Timeout -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - {timeout,_,_} = Timeout -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - {timeout,_,_,_} = Timeout -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - {state_timeout,_,_} = Timeout -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - {state_timeout,_,_,_} = Timeout -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout); - Time -> - parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Time) + [Class,Reason,erlang:get_stacktrace()] end. -parse_actions_timeout( - Debug, S, State, Actions, - Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout) -> - case Timeout of - {TimerType,Time,TimerMsg,TimerOpts} -> - case validate_timer_args(Time, listify(TimerOpts)) of - true -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], - Postpone, NextEventsR); - false -> - NewTimeout = {TimerType,Time,TimerMsg}, - parse_actions( - Debug, S, State, Actions, - Hibernate, [NewTimeout|TimeoutsR], - Postpone, NextEventsR); - error -> - {error, - {bad_action_from_state_function,Timeout}, - ?STACKTRACE()} - end; - {_,Time,_} -> - case validate_timer_args(Time, []) of - false -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], - Postpone, NextEventsR); - error -> - {error, - {bad_action_from_state_function,Timeout}, - ?STACKTRACE()} - end; - Time -> - case validate_timer_args(Time, []) of - false -> - parse_actions( - Debug, S, State, Actions, - Hibernate, [Timeout|TimeoutsR], - Postpone, NextEventsR); - error -> - {error, - {bad_action_from_state_function,Timeout}, - ?STACKTRACE()} - end - end. -validate_timer_args(Time, Opts) -> - validate_timer_args(Time, Opts, false). +%% -> absolute | relative | badarg +classify_timer(Time, Opts) -> + classify_timer(Time, Opts, false). %% -validate_timer_args(Time, [], true) when is_integer(Time) -> - true; -validate_timer_args(Time, [], false) when is_integer(Time), Time >= 0 -> - false; -validate_timer_args(infinity, [], Abs) -> - Abs; -validate_timer_args(Time, [{abs,Abs}|Opts], _) when is_boolean(Abs) -> - validate_timer_args(Time, Opts, Abs); -validate_timer_args(_, [_|_], _) -> - error. +classify_timer(Time, [], Abs) -> + case Abs of + true when + is_integer(Time); + Time =:= infinity -> + absolute; + false when + is_integer(Time), 0 =< Time; + Time =:= infinity -> + relative; + _ -> + badarg + end; +classify_timer(Time, [{abs,Abs}|Opts], _) when is_boolean(Abs) -> + classify_timer(Time, Opts, Abs); +classify_timer(_, Opts, _) when is_list(Opts) -> + badarg. %% Stop and start timers as well as create timeout zero events %% and pending event timer %% %% Stop and start timers non-event timers -parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR) -> - parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR, #{}, []). +parse_timers(TimerRefs, Timers, TimeoutsR) -> + parse_timers(TimerRefs, Timers, TimeoutsR, #{}, []). %% parse_timers( - TimerRefs, TimerTypes, CancelTimers, [], _Seen, TimeoutEvents) -> - {TimerRefs,TimerTypes,CancelTimers,TimeoutEvents}; + TimerRefs, Timers, [], _Seen, TimeoutEvents) -> + %% + {TimerRefs,Timers,TimeoutEvents}; parse_timers( - TimerRefs, TimerTypes, CancelTimers, [Timeout|TimeoutsR], - Seen, TimeoutEvents) -> + TimerRefs, Timers, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> + %% case Timeout of {TimerType,Time,TimerMsg,TimerOpts} -> %% Absolute timer parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, TimerType, Time, TimerMsg, listify(TimerOpts)); %% Relative timers below {TimerType,0,TimerMsg} -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, TimerType, zero, TimerMsg, []); {TimerType,Time,TimerMsg} -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, TimerType, Time, TimerMsg, []); 0 -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, timeout, zero, 0, []); Time -> parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, timeout, Time, Time, []) end. parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents, + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents, TimerType, Time, TimerMsg, TimerOpts) -> case Seen of #{TimerType := _} -> %% Type seen before - ignore parse_timers( - TimerRefs, TimerTypes, CancelTimers, TimeoutsR, - Seen, TimeoutEvents); + TimerRefs, Timers, TimeoutsR, Seen, TimeoutEvents); #{} -> %% Unseen type - handle NewSeen = Seen#{TimerType => true}, case Time of infinity -> %% Cancel any running timer - {NewTimerTypes,NewCancelTimers} = - cancel_timer_by_type( - TimerType, TimerTypes, CancelTimers), parse_timers( - TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, - NewSeen, TimeoutEvents); + TimerRefs, cancel_timer_by_type(TimerType, Timers), + TimeoutsR, NewSeen, TimeoutEvents); zero -> %% Cancel any running timer - {NewTimerTypes,NewCancelTimers} = - cancel_timer_by_type( - TimerType, TimerTypes, CancelTimers), %% Handle zero time timeouts later - TimeoutEvent = {TimerType,TimerMsg}, parse_timers( - TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR, - NewSeen, [TimeoutEvent|TimeoutEvents]); + TimerRefs, cancel_timer_by_type(TimerType, Timers), + TimeoutsR, NewSeen, + [{TimerType,TimerMsg}|TimeoutEvents]); _ -> %% (Re)start the timer TimerRef = erlang:start_timer( Time, self(), TimerMsg, TimerOpts), - case TimerTypes of - #{TimerType := OldTimerRef} -> + case Timers of + {#{TimerType := OldTimerRef} = TimerTypes, + CancelTimers} -> %% Cancel the running timer cancel_timer(OldTimerRef), NewCancelTimers = CancelTimers + 1, @@ -1575,17 +1743,17 @@ parse_timers( %% both TimerRefs and TimerTypes parse_timers( TimerRefs#{TimerRef => TimerType}, - TimerTypes#{TimerType => TimerRef}, - NewCancelTimers, TimeoutsR, - NewSeen, TimeoutEvents); - #{} -> + {TimerTypes#{TimerType => TimerRef}, + NewCancelTimers}, + TimeoutsR, NewSeen, TimeoutEvents); + {#{} = TimerTypes,CancelTimers} -> %% Insert the new timer into %% both TimerRefs and TimerTypes parse_timers( TimerRefs#{TimerRef => TimerType}, - TimerTypes#{TimerType => TimerRef}, - CancelTimers, TimeoutsR, - NewSeen, TimeoutEvents) + {TimerTypes#{TimerType => TimerRef}, + CancelTimers}, + TimeoutsR, NewSeen, TimeoutEvents) end end end. @@ -1607,6 +1775,8 @@ prepend_timeout_events([], EventsR) -> prepend_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) -> prepend_timeout_events(TimeoutEvents, [TimeoutEvent]); prepend_timeout_events([{timeout,_}|TimeoutEvents], EventsR) -> + %% Ignore since there are other events in queue + %% so they have cancelled the event timeout 0. prepend_timeout_events(TimeoutEvents, EventsR); prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) -> %% Just prepend all others @@ -1617,23 +1787,28 @@ prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) -> %%--------------------------------------------------------------------------- %% Server helpers -reply_then_terminate( - Class, Reason, Stacktrace, Debug, - #{state := State} = S, Q, Replies) -> +reply_then_terminate(Class, Reason, Stacktrace, Debug, S, Q, Replies) -> do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, - S, Q, listify(Replies), State). + Class, Reason, Stacktrace, Debug, S, Q, listify(Replies)). %% do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, [], _State) -> + Class, Reason, Stacktrace, Debug, S, Q, []) -> terminate(Class, Reason, Stacktrace, Debug, S, Q); do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, [R|Rs], State) -> + Class, Reason, Stacktrace, Debug, S, Q, [R|Rs]) -> case R of {reply,{_To,_Tag}=From,Reply} -> - NewDebug = do_reply(Debug, S, State, From, Reply), + reply(From, Reply), + NewDebug = + ?sys_debug( + Debug, + begin + #state{name = Name, state = State} = S, + {Name,State} + end, + {out,Reply,From}), do_reply_then_terminate( - Class, Reason, Stacktrace, NewDebug, S, Q, Rs, State); + Class, Reason, Stacktrace, NewDebug, S, Q, Rs); _ -> terminate( error, @@ -1642,14 +1817,9 @@ do_reply_then_terminate( Debug, S, Q) end. -do_reply(Debug, S, State, From, Reply) -> - reply(From, Reply), - sys_debug(Debug, S, State, {out,Reply,From}). - - terminate( Class, Reason, Stacktrace, Debug, - #{module := Module, state := State, data := Data, postponed := P} = S, + #state{module = Module, state = State, data = Data} = S, Q) -> case erlang:function_exported(Module, terminate, 3) of true -> @@ -1660,7 +1830,7 @@ terminate( C:R -> ST = erlang:get_stacktrace(), error_info( - C, R, ST, S, Q, P, + C, R, ST, S, Q, format_status(terminate, get(), S)), sys:print_log(Debug), erlang:raise(C, R, ST) @@ -1671,14 +1841,14 @@ terminate( _ = case Reason of normal -> - sys_debug(Debug, S, State, {terminate,Reason}); + terminate_sys_debug(Debug, S, State, Reason); shutdown -> - sys_debug(Debug, S, State, {terminate,Reason}); + terminate_sys_debug(Debug, S, State, Reason); {shutdown,_} -> - sys_debug(Debug, S, State, {terminate,Reason}); + terminate_sys_debug(Debug, S, State, Reason); _ -> error_info( - Class, Reason, Stacktrace, S, Q, P, + Class, Reason, Stacktrace, S, Q, format_status(terminate, get(), S)), sys:print_log(Debug) end, @@ -1689,12 +1859,18 @@ terminate( erlang:raise(Class, Reason, Stacktrace) end. +terminate_sys_debug(Debug, S, State, Reason) -> + ?sys_debug(Debug, {S#state.name,State}, {terminate,Reason}). + + error_info( Class, Reason, Stacktrace, - #{name := Name, - callback_mode := CallbackMode, - state_enter := StateEnter}, - Q, P, FmtData) -> + #state{ + name = Name, + callback_mode = CallbackMode, + state_enter = StateEnter, + postponed = P}, + Q, FmtData) -> {FixedReason,FixedStacktrace} = case Stacktrace of [{M,F,Args,_}|ST] @@ -1775,7 +1951,7 @@ error_info( %% Call Module:format_status/2 or return a default value format_status( Opt, PDict, - #{module := Module, state := State, data := Data}) -> + #state{module = Module, state = State, data = Data}) -> case erlang:function_exported(Module, format_status, 2) of true -> try Module:format_status(Opt, [PDict,State,Data]) @@ -1800,6 +1976,7 @@ format_status_default(Opt, State, Data) -> [{data,[{"State",StateData}]}] end. +-compile({inline, [listify/1]}). listify(Item) when is_list(Item) -> Item; listify(Item) -> @@ -1813,14 +1990,16 @@ listify(Item) -> %% %% Remove the timer from TimerTypes. %% When we get the cancel_timer msg we remove it from TimerRefs. -cancel_timer_by_type(TimerType, TimerTypes, CancelTimers) -> +-compile({inline, [cancel_timer_by_type/2]}). +cancel_timer_by_type(TimerType, {TimerTypes,CancelTimers} = TT_CT) -> case TimerTypes of #{TimerType := TimerRef} -> - cancel_timer(TimerRef), + ok = erlang:cancel_timer(TimerRef, [{async,true}]), {maps:remove(TimerType, TimerTypes),CancelTimers + 1}; #{} -> - {TimerTypes,CancelTimers} + TT_CT end. +-compile({inline, [cancel_timer/1]}). cancel_timer(TimerRef) -> ok = erlang:cancel_timer(TimerRef, [{async,true}]). diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl index 3c8430b820..cacd9f2524 100644 --- a/lib/stdlib/src/io_lib.erl +++ b/lib/stdlib/src/io_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -149,7 +149,7 @@ fread(Chars, Format) -> -spec fread(Continuation, CharSpec, Format) -> Return when Continuation :: continuation() | [], - CharSpec :: string() | eof, + CharSpec :: string() | 'eof', Format :: string(), Return :: {'more', Continuation1 :: continuation()} | {'done', Result, LeftOverChars :: string()}, diff --git a/lib/stdlib/src/io_lib_fread.erl b/lib/stdlib/src/io_lib_fread.erl index 983e8d4566..319bff484e 100644 --- a/lib/stdlib/src/io_lib_fread.erl +++ b/lib/stdlib/src/io_lib_fread.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -38,7 +38,7 @@ -spec fread(Continuation, String, Format) -> Return when Continuation :: io_lib:continuation() | [], - String :: string(), + String :: string() | 'eof', Format :: string(), Return :: {'more', Continuation1 :: io_lib:continuation()} | {'done', Result, LeftOverChars :: string()}, diff --git a/lib/stdlib/src/sys.erl b/lib/stdlib/src/sys.erl index 1f966411c5..0c578acf21 100644 --- a/lib/stdlib/src/sys.erl +++ b/lib/stdlib/src/sys.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -38,7 +38,9 @@ -export_type([dbg_opt/0]). --type name() :: pid() | atom() | {'global', atom()}. +-type name() :: pid() | atom() + | {'global', term()} + | {'via', module(), term()}. -type system_event() :: {'in', Msg :: _} | {'in', Msg :: _, From :: _} | {'out', Msg :: _, To :: _} diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 915f478dfa..9123bf2f28 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2017. All Rights Reserved. +%% Copyright Ericsson AB 1998-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -551,8 +551,8 @@ otp_8130(Config) when is_list(Config) -> "t() -> " " L = \"{ 34 , \\\"1\\\\x{AAA}\\\" , \\\"34\\\" , X . a , $\\\\x{AAA} }\", " " R = ?M({34,\"1\\x{aaa}\",\"34\",X.a,$\\x{aaa}})," - " Lt = erl_scan:string(L, 1, [unicode])," - " Rt = erl_scan:string(R, 1, [unicode])," + " Lt = erl_scan:string(L, 1)," + " Rt = erl_scan:string(R, 1)," " Lt = Rt, ok. ">>, ok}, diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 5efffc6a5c..e40f5e9a5d 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2017. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -3982,8 +3982,9 @@ non_latin1_module(Config) -> do_non_latin1_module(Mod) -> File = atom_to_list(Mod) ++ ".erl", - Forms = [{attribute,1,file,{File,1}}, - {attribute,1,module,Mod}, + L1 = erl_anno:new(1), + Forms = [{attribute,L1,file,{File,1}}, + {attribute,L1,module,Mod}, {eof,2}], error = compile:forms(Forms), {error,_,[]} = compile:forms(Forms, [return]), diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl index 808ba9b4c1..dda8d0a12e 100644 --- a/lib/stdlib/test/erl_pp_SUITE.erl +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2017. All Rights Reserved. +%% Copyright Ericsson AB 2006-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1262,7 +1262,7 @@ parse_forms(Chars) -> parse_forms2([], _Cont, _Line, Forms) -> lists:reverse(Forms); parse_forms2(String, Cont0, Line, Forms) -> - case erl_scan:tokens(Cont0, String, Line, [unicode]) of + case erl_scan:tokens(Cont0, String, Line) of {done, {ok, Tokens, EndLine}, Chars} -> {ok, Form} = erl_parse:parse_form(Tokens), parse_forms2(Chars, [], EndLine, [Form | Forms]); @@ -1303,7 +1303,7 @@ parse_and_pp_expr(String, Indent, Options) -> erl_pp:expr(parse_expr(StringDot), Indent, Options). parse_expr(Chars) -> - {ok, Tokens, _} = erl_scan:string(Chars, 1, [unicode]), + {ok, Tokens, _} = erl_scan:string(Chars, 1), {ok, [Expr]} = erl_parse:parse_exprs(Tokens), Expr. diff --git a/lib/stdlib/test/escript_SUITE_data/unicode1 b/lib/stdlib/test/escript_SUITE_data/unicode1 index 351bb785e5..8dc9d450b8 100755 --- a/lib/stdlib/test/escript_SUITE_data/unicode1 +++ b/lib/stdlib/test/escript_SUITE_data/unicode1 @@ -8,7 +8,7 @@ main(_) -> _D = erlang:system_flag(backtrace_depth, 0), A = <<"\x{aaa}"/utf8>>, S = lists:flatten(io_lib:format("~p/~p.", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B). diff --git a/lib/stdlib/test/escript_SUITE_data/unicode2 b/lib/stdlib/test/escript_SUITE_data/unicode2 index 495188f6f0..d0195b036c 100755 --- a/lib/stdlib/test/escript_SUITE_data/unicode2 +++ b/lib/stdlib/test/escript_SUITE_data/unicode2 @@ -8,7 +8,7 @@ main(_) -> _D = erlang:system_flag(backtrace_depth, 0), A = <<"\x{aa}">>, S = lists:flatten(io_lib:format("~p/~p.", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B). diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl index 86cf58566b..41ee3246f5 100644 --- a/lib/stdlib/test/gen_fsm_SUITE.erl +++ b/lib/stdlib/test/gen_fsm_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -389,7 +389,7 @@ stop10(_Config) -> Dir = filename:dirname(code:which(?MODULE)), rpc:call(Node,code,add_path,[Dir]), {ok, Pid} = rpc:call(Node,gen_fsm,start,[{global,to_stop},?MODULE,[],[]]), - global:sync(), + ok = global:sync(), ok = gen_fsm:stop({global,to_stop}), false = rpc:call(Node,erlang,is_process_alive,[Pid]), {'EXIT',noproc} = (catch gen_fsm:stop({global,to_stop})), @@ -1005,7 +1005,7 @@ undef_in_terminate(Config) when is_list(Config) -> State = {undef_in_terminate, {?MODULE, terminate}}, {ok, FSM} = gen_fsm:start(?MODULE, {state_data, State}, []), try - gen_fsm:stop(FSM), + ok = gen_fsm:stop(FSM), ct:fail(failed) catch exit:{undef, [{?MODULE, terminate, _, _}|_]} -> @@ -1201,7 +1201,7 @@ timeout({timeout,Ref,{timeout,Time}}, {From,Ref}) -> Cref = gen_fsm:start_timer(Time, cancel), Time4 = Time*4, receive after Time4 -> ok end, - gen_fsm:cancel_timer(Cref), + _= gen_fsm:cancel_timer(Cref), {next_state, timeout, {From,Ref2}}; timeout({timeout,Ref2,ok},{From,Ref2}) -> gen_fsm:reply(From, ok), diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl index 2bc220fef2..e29195e895 100644 --- a/lib/stdlib/test/gen_server_SUITE.erl +++ b/lib/stdlib/test/gen_server_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2017. All Rights Reserved. +%% Copyright Ericsson AB 1996-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -347,7 +347,7 @@ stop10(_Config) -> Dir = filename:dirname(code:which(?MODULE)), rpc:call(Node,code,add_path,[Dir]), {ok, Pid} = rpc:call(Node,gen_server,start,[{global,to_stop},?MODULE,[],[]]), - global:sync(), + ok = global:sync(), ok = gen_server:stop({global,to_stop}), false = rpc:call(Node,erlang,is_process_alive,[Pid]), {'EXIT',noproc} = (catch gen_server:stop({global,to_stop})), @@ -509,7 +509,7 @@ start_node(Name) -> %% After starting a slave, it takes a little while until global knows %% about it, even if nodes() includes it, so we make sure that global %% knows about it before registering something on all nodes. - global:sync(), + ok = global:sync(), N. call_remote1(Config) when is_list(Config) -> @@ -647,7 +647,7 @@ cast_fast(Config) when is_list(Config) -> cast_fast_messup() -> %% Register a false node: hopp@hostname unregister(erl_epmd), - erl_epmd:start_link(), + {ok, _} = erl_epmd:start_link(), {ok,S} = gen_tcp:listen(0, []), {ok,P} = inet:port(S), {ok,_Creation} = erl_epmd:register_node(hopp, P), @@ -1351,7 +1351,7 @@ do_call_with_huge_message_queue() -> {Time,ok} = tc(fun() -> calls(10000, Pid) end), - [self() ! {msg,N} || N <- lists:seq(1, 500000)], + _ = [self() ! {msg,N} || N <- lists:seq(1, 500000)], erlang:garbage_collect(), {NewTime,ok} = tc(fun() -> calls(10000, Pid) end), io:format("Time for empty message queue: ~p", [Time]), @@ -1476,7 +1476,7 @@ undef_in_terminate(Config) when is_list(Config) -> State = {undef_in_terminate, {oc_server, terminate}}, {ok, Server} = gen_server:start(?MODULE, {state, State}, []), try - gen_server:stop(Server), + ok = gen_server:stop(Server), ct:fail(failed) catch exit:{undef, [{oc_server, terminate, [], _}|_]} -> @@ -1674,7 +1674,7 @@ handle_cast({From,delayed_cast,T}, _State) -> handle_cast(hibernate_now, _State) -> {noreply, [], hibernate}; handle_cast(hibernate_later, _State) -> - timer:send_after(1000,self(),hibernate_now), + {ok, _} = timer:send_after(1000,self(),hibernate_now), {noreply, []}; handle_cast({call_undef_fun, Mod, Fun}, State) -> Mod:Fun(), diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl index 5b9daecfd3..c747db475a 100644 --- a/lib/stdlib/test/gen_statem_SUITE.erl +++ b/lib/stdlib/test/gen_statem_SUITE.erl @@ -21,7 +21,7 @@ -include_lib("common_test/include/ct.hrl"). --compile(export_all). +-compile([export_all, nowarn_export_all]). -behaviour(gen_statem). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 13929bdbb6..45363c0592 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2017. All Rights Reserved. +%% Copyright Ericsson AB 1999-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -714,7 +714,7 @@ p(Term, D) -> rp(Term, 1, 80, D). p(Term, Col, Ll, D) -> - rp(Term, Col, Ll, D, no_fun). + rp(Term, Col, Ll, D, none). rp(Term, Col, Ll, D) -> rp(Term, Col, Ll, D, fun rfd/2). @@ -724,6 +724,8 @@ rp(Term, Col, Ll, D) -> rp(Term, Col, Ll, D, RF) -> rp(Term, Col, Ll, D, ?MAXCS, RF). +rp(Term, Col, Ll, D, M, none) -> + rp(Term, Col, Ll, D, M, fun(_, _) -> no end); rp(Term, Col, Ll, D, M, RF) -> %% io:format("~n~n*** Col = ~p Ll = ~p D = ~p~n~p~n-->~n", %% [Col, Ll, D, Term]), diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 217e8cc252..ca85314775 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2017. All Rights Reserved. +%% Copyright Ericsson AB 2004-2018. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -561,9 +561,10 @@ otp_5226(Config) when is_list(Config) -> otp_5327(Config) when is_list(Config) -> "exception error: bad argument" = comm_err(<<"<<\"hej\":default>>.">>), + L1 = erl_anno:new(1), <<"abc">> = - erl_parse:normalise({bin,1,[{bin_element,1,{string,1,"abc"}, - default,default}]}), + erl_parse:normalise({bin,L1,[{bin_element,L1,{string,L1,"abc"}, + default,default}]}), [<<"abc">>] = scan(<<"<<(<<\"abc\">>):3/binary>>.">>), [<<"abc">>] = scan(<<"<<(<<\"abc\">>)/binary>>.">>), "exception error: bad argument" = @@ -576,9 +577,9 @@ otp_5327(Config) when is_list(Config) -> comm_err(<<"<<10:default>>.">>), [<<98,1:1>>] = scan(<<"<<3:3,5:6>>.">>), {'EXIT',{badarg,_}} = - (catch erl_parse:normalise({bin,1,[{bin_element,1,{integer,1,17}, - {atom,1,all}, - default}]})), + (catch erl_parse:normalise({bin,L1,[{bin_element,L1,{integer,L1,17}, + {atom,L1,all}, + default}]})), [<<-20/signed>>] = scan(<<"<<-20/signed>> = <<-20>>.">>), [<<-300:16/signed>>] = scan(<<"<<-300:16/signed>> = <<-300:16>>.">>), @@ -2784,7 +2785,7 @@ otp_10302(Config) when is_list(Config) -> <<"begin A = <<\"\\xaa\">>, S = lists:flatten(io_lib:format(\"~p/~p.\", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B) @@ -2797,7 +2798,7 @@ otp_10302(Config) when is_list(Config) -> <<"io:setopts([{encoding,utf8}]). A = <<\"\\xaa\">>, S = lists:flatten(io_lib:format(\"~p/~p.\", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B).">>, @@ -2809,7 +2810,7 @@ otp_10302(Config) when is_list(Config) -> <<"begin A = [1089], S = lists:flatten(io_lib:format(\"~tp/~tp.\", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B) @@ -2821,7 +2822,7 @@ otp_10302(Config) when is_list(Config) -> <<"io:setopts([{encoding,utf8}]). A = [1089], S = lists:flatten(io_lib:format(\"~tp/~tp.\", [A, A])), - {ok, Ts, _} = erl_scan:string(S, 1, [unicode]), + {ok, Ts, _} = erl_scan:string(S, 1), {ok, Es} = erl_parse:parse_exprs(Ts), B = erl_eval:new_bindings(), erl_eval:exprs(Es, B).">>, @@ -2940,7 +2941,7 @@ otp_14296(Config) when is_list(Config) -> end(), fun() -> - Port = open_port({spawn, "ls"}, [line]), + Port = open_port({spawn, "ls"}, [{line,1}]), KnownPort = erlang:port_to_list(Port), S = KnownPort ++ ".", R = KnownPort ++ ".\n", @@ -3012,7 +3013,7 @@ scan(B) -> scan(t(B), F). scan(S0, F) -> - case erl_scan:tokens([], S0, 1, [unicode]) of + case erl_scan:tokens([], S0, 1) of {done,{ok,Ts,_},S} -> [F(Ts) | scan(S, F)]; _Else -> diff --git a/lib/stdlib/test/stdlib.spec b/lib/stdlib/test/stdlib.spec index 1adec67ac9..9c625091a8 100644 --- a/lib/stdlib/test/stdlib.spec +++ b/lib/stdlib/test/stdlib.spec @@ -1,3 +1,4 @@ {suites,"../stdlib_test",all}. -{skip_groups,"../stdlib_test",stdlib_bench_SUITE,[base64,gen_server,unicode], +{skip_groups,"../stdlib_test",stdlib_bench_SUITE, + [base64,gen_server,gen_statem,unicode], "Benchmark only"}. diff --git a/lib/stdlib/test/stdlib_bench.spec b/lib/stdlib/test/stdlib_bench.spec index f82f1ab9b3..7a0da811a0 100644 --- a/lib/stdlib/test/stdlib_bench.spec +++ b/lib/stdlib/test/stdlib_bench.spec @@ -5,5 +5,6 @@ {skip_suites,"../stdlib_test",string_SUITE, "bench only"}. {suites,"../stdlib_test",[stdlib_bench_SUITE]}. -{skip_groups,"../stdlib_test",stdlib_bench_SUITE,[gen_server_comparison], +{skip_groups,"../stdlib_test",stdlib_bench_SUITE, + [gen_server_comparison,gen_statem_comparison], "Not a benchmark"}. diff --git a/lib/stdlib/test/stdlib_bench_SUITE.erl b/lib/stdlib/test/stdlib_bench_SUITE.erl index 9ad4bae2f5..294898a932 100644 --- a/lib/stdlib/test/stdlib_bench_SUITE.erl +++ b/lib/stdlib/test/stdlib_bench_SUITE.erl @@ -30,7 +30,8 @@ suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. all() -> [{group,unicode},{group,base64}, - {group,gen_server},{group,gen_server_comparison}]. + {group,gen_server},{group,gen_statem}, + {group,gen_server_comparison},{group,gen_statem_comparison}]. groups() -> [{unicode,[{repeat,5}], @@ -44,20 +45,39 @@ groups() -> encode_list, encode_list_to_string, mime_binary_decode, mime_binary_decode_to_string, mime_list_decode, mime_list_decode_to_string]}, - {gen_server, [{repeat,5}], - [simple, simple_timer, simple_mon, simple_timer_mon, - generic, generic_timer]}, + {gen_server, [{repeat,5}], cases(gen_server)}, + {gen_statem, [{repeat,3}], cases(gen_statem)}, {gen_server_comparison, [], [single_small, single_medium, single_big, sched_small, sched_medium, sched_big, - multi_small, multi_medium, multi_big]}]. + multi_small, multi_medium, multi_big]}, + {gen_statem_comparison, [], + [single_small, single_big, + sched_small, sched_big, + multi_small, multi_big]}]. -init_per_group(GroupName, Config) when GroupName =:= gen_server; - GroupName =:= gen_server_comparison -> - DataDir = ?config(data_dir, Config), - Files = filelib:wildcard(filename:join(DataDir, "{simple,generic}*.erl")), - _ = [{ok, _} = compile:file(File) || File <- Files], - Config; +cases(gen_server) -> + [simple, simple_timer, simple_mon, simple_timer_mon, + generic, generic_timer]; +cases(gen_statem) -> + [generic, generic_fsm, generic_fsm_transit, + generic_statem, generic_statem_transit, + generic_statem_complex]. + +init_per_group(gen_server, Config) -> + compile_servers(Config), + [{benchmark_suite,"stdlib_gen_server"}|Config]; +init_per_group(gen_statem, Config) -> + compile_servers(Config), + [{benchmark_suite,"stdlib_gen_statem"}|Config]; +init_per_group(gen_server_comparison, Config) -> + compile_servers(Config), + [{cases,cases(gen_server)}, + {benchmark_suite,"stdlib_gen_server"}|Config]; +init_per_group(gen_statem_comparison, Config) -> + compile_servers(Config), + [{cases,cases(gen_statem)}, + {benchmark_suite,"stdlib_gen_statem"}|Config]; init_per_group(_GroupName, Config) -> Config. @@ -77,23 +97,33 @@ end_per_testcase(_Func, _Conf) -> ok. +compile_servers(Config) -> + DataDir = ?config(data_dir, Config), + Files = filelib:wildcard(filename:join(DataDir, "{simple,generic}*.erl")), + _ = [{ok, _} = compile:file(File) || File <- Files], + ok. + +comment(Value) -> + C = lists:flatten(io_lib:format("~p", [Value])), + {comment, C}. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -define(REPEAT_NORM, 5). norm_nfc_list(Config) -> Bin = norm_data(Config), {_N, Mean, _Stddev, Res} = unicode_util_SUITE:time_count(nfc, list, Bin, ?REPEAT_NORM), - report(1000.0*Res / Mean). + comment(report(1000.0*Res / Mean)). norm_nfc_deep_l(Config) -> Bin = norm_data(Config), {_N, Mean, _Stddev, Res} = unicode_util_SUITE:time_count(nfc, deep_l, Bin, ?REPEAT_NORM), - report(1000.0*Res / Mean). + comment(report(1000.0*Res / Mean)). norm_nfc_binary(Config) -> Bin = norm_data(Config), {_N, Mean, _Stddev, Res} = unicode_util_SUITE:time_count(nfc, binary, Bin, ?REPEAT_NORM), - report(1000.0*Res / Mean). + comment(report(1000.0*Res / Mean)). string_lexemes_list(Config) -> @@ -102,7 +132,7 @@ string_lexemes_list(Config) -> Bin = norm_data(Config), Fun = fun(Str) -> string:nth_lexeme(Str, 200000, [$;,$\n,$\r]), 200000 end, {_N, Mean, _Stddev, Res} = string_SUITE:time_func(Fun, list, Bin, 15), - report(1000.0*Res / Mean). + comment(report(1000.0*Res / Mean)). string_lexemes_binary(Config) -> %% Use nth_lexeme instead of lexemes to avoid building a result of @@ -110,7 +140,7 @@ string_lexemes_binary(Config) -> Bin = norm_data(Config), Fun = fun(Str) -> string:nth_lexeme(Str, 200000, [$;,$\n,$\r]), 200000 end, {_N, Mean, _Stddev, Res} = string_SUITE:time_func(Fun, binary, Bin, ?REPEAT_NORM), - report(1000.0*Res / Mean). + comment(report(1000.0*Res / Mean)). %%% report(Tps) -> @@ -128,40 +158,40 @@ norm_data(Config) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% decode_binary(_Config) -> - test(decode, encoded_binary()). + comment(test(decode, encoded_binary())). decode_binary_to_string(_Config) -> - test(decode_to_string, encoded_binary()). + comment(test(decode_to_string, encoded_binary())). decode_list(_Config) -> - test(decode, encoded_list()). + comment(test(decode, encoded_list())). decode_list_to_string(_Config) -> - test(decode_to_string, encoded_list()). + comment(test(decode_to_string, encoded_list())). encode_binary(_Config) -> - test(encode, binary()). + comment(test(encode, binary())). encode_binary_to_string(_Config) -> - test(encode_to_string, binary()). + comment(test(encode_to_string, binary())). encode_list(_Config) -> - test(encode, list()). + comment(test(encode, list())). encode_list_to_string(_Config) -> - test(encode_to_string, list()). + comment(test(encode_to_string, list())). mime_binary_decode(_Config) -> - test(mime_decode, encoded_binary()). + comment(test(mime_decode, encoded_binary())). mime_binary_decode_to_string(_Config) -> - test(mime_decode_to_string, encoded_binary()). + comment(test(mime_decode_to_string, encoded_binary())). mime_list_decode(_Config) -> - test(mime_decode, encoded_list()). + comment(test(mime_decode, encoded_list())). mime_list_decode_to_string(_Config) -> - test(mime_decode_to_string, encoded_list()). + comment(test(mime_decode_to_string, encoded_list())). -define(SIZE, 10000). -define(N, 1000). @@ -223,94 +253,106 @@ mbb(N, Acc) -> lists:reverse(Acc, B). simple(Config) when is_list(Config) -> - do_tests(simple, single_small). + comment(do_tests(simple, single_small, Config)). simple_timer(Config) when is_list(Config) -> - do_tests(simple_timer, single_small). + comment(do_tests(simple_timer, single_small, Config)). simple_mon(Config) when is_list(Config) -> - do_tests(simple_mon, single_small). + comment(do_tests(simple_mon, single_small, Config)). simple_timer_mon(Config) when is_list(Config) -> - do_tests(simple_timer_mon, single_small). + comment(do_tests(simple_timer_mon, single_small, Config)). generic(Config) when is_list(Config) -> - do_tests(generic, single_small). + comment(do_tests(generic, single_small, Config)). generic_timer(Config) when is_list(Config) -> - do_tests(generic_timer, single_small). + comment(do_tests(generic_timer, single_small, Config)). + +generic_statem(Config) when is_list(Config) -> + comment(do_tests(generic_statem, single_small, Config)). + +generic_statem_transit(Config) when is_list(Config) -> + comment(do_tests(generic_statem_transit, single_small, Config)). + +generic_statem_complex(Config) when is_list(Config) -> + comment(do_tests(generic_statem_complex, single_small, Config)). + +generic_fsm(Config) when is_list(Config) -> + comment(do_tests(generic_fsm, single_small, Config)). + +generic_fsm_transit(Config) when is_list(Config) -> + comment(do_tests(generic_fsm_transit, single_small, Config)). single_small(Config) when is_list(Config) -> - comparison(single_small). + comparison(?config(cases, Config), single_small, Config). single_medium(Config) when is_list(Config) -> - comparison(single_medium). + comparison(?config(cases, Config), single_medium, Config). single_big(Config) when is_list(Config) -> - comparison(single_big). + comparison(?config(cases, Config), single_big, Config). sched_small(Config) when is_list(Config) -> - comparison(sched_small). + comparison(?config(cases, Config), sched_small, Config). sched_medium(Config) when is_list(Config) -> - comparison(sched_medium). + comparison(?config(cases, Config), sched_medium, Config). sched_big(Config) when is_list(Config) -> - comparison(sched_big). + comparison(?config(cases, Config), sched_big, Config). multi_small(Config) when is_list(Config) -> - comparison(multi_small). + comparison(?config(cases, Config), multi_small, Config). multi_medium(Config) when is_list(Config) -> - comparison(multi_medium). + comparison(?config(cases, Config), multi_medium, Config). multi_big(Config) when is_list(Config) -> - comparison(multi_big). - -comparison(Kind) -> - Simple0 = do_tests(simple, Kind), - SimpleTimer0 = do_tests(simple_timer, Kind), - SimpleMon0 = do_tests(simple_mon, Kind), - SimpleTimerMon0 = do_tests(simple_timer_mon, Kind), - Generic0 = do_tests(generic, Kind), - GenericTimer0 = do_tests(generic_timer, Kind), - %% Normalize - Simple = norm(Simple0, Simple0), - SimpleTimer = norm(SimpleTimer0, Simple0), - SimpleMon = norm(SimpleMon0, Simple0), - SimpleTimerMon = norm(SimpleTimerMon0, Simple0), - Generic = norm(Generic0, Simple0), - GenericTimer = norm(GenericTimer0, Simple0), + comparison(?config(cases, Config), multi_big, Config). + +comparison(Cases, Kind, Config) -> + Cases = ?config(cases, Config), + [RefResult|_] = Results = + [do_tests(Case, Kind, Config) || Case <- Cases], + Normalized = [norm(Result, RefResult) || Result <- Results], {Parallelism, Message} = bench_params(Kind), Wordsize = erlang:system_info(wordsize), MSize = Wordsize * erts_debug:flat_size(Message), What = io_lib:format("#parallel gen_server instances: ~.4w, " "message flat size: ~.5w bytes", [Parallelism, MSize]), - C = io_lib:format("~s: " - "Simple: ~s Simple+Timer: ~s " - "Simple+Monitor: ~s Simple+Timer+Monitor: ~s " - "Generic: ~s Generic+Timer: ~s", - [What, Simple, SimpleTimer, SimpleMon, SimpleTimerMon, - Generic, GenericTimer]), + Format = + lists:flatten( + ["~s: "] ++ + [[atom_to_list(Case),": ~s "] || Case <- Cases]), + C = lists:flatten(io_lib:format(Format, [What] ++ Normalized)), {comment, C}. norm(T, Ref) -> - io_lib:format("~.2f", [Ref/T]). + try Ref / T of + Norm -> + io_lib:format("~.2f", [Norm]) + catch error:badarith -> + "---" + end. -define(MAX_TIME_SECS, 3). % s -define(MAX_TIME, 1000 * ?MAX_TIME_SECS). % ms -define(CALLS_PER_LOOP, 5). -do_tests(Test, ParamSet) -> +do_tests(Test, ParamSet, Config) -> + BenchmarkSuite = ?config(benchmark_suite, Config), {Client, ServerMod} = bench(Test), {Parallelism, Message} = bench_params(ParamSet), Fun = create_clients(Message, ServerMod, Client, Parallelism), {TotalLoops, AllPidTime} = run_test(Fun), PerSecond = ?CALLS_PER_LOOP * round((1000 * TotalLoops) / AllPidTime), - ct_event:notify(#event{name = benchmark_data, - data = [{suite,"stdlib_gen_server"}, - {value,PerSecond}]}), + ct_event:notify( + #event{ + name = benchmark_data, + data = [{suite,BenchmarkSuite},{value,PerSecond}]}), PerSecond. -define(COUNTER, n). @@ -369,6 +411,51 @@ generic_timer_client(N, M, P) -> _ = generic_server_timer:reply(P, M), generic_timer_client(N+1, M, P). +generic_statem_client(N, M, P) -> + put(?COUNTER, N), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + generic_statem_client(N+1, M, P). + +generic_statem_transit_client(N, M, P) -> + put(?COUNTER, N), + _ = generic_statem:transit(P, M), + _ = generic_statem:transit(P, M), + _ = generic_statem:transit(P, M), + _ = generic_statem:transit(P, M), + _ = generic_statem:transit(P, M), + generic_statem_transit_client(N+1, M, P). + +generic_statem_complex_client(N, M, P) -> + put(?COUNTER, N), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + _ = generic_statem:reply(P, M), + generic_statem_complex_client(N+1, M, P). + +generic_fsm_client(N, M, P) -> + put(?COUNTER, N), + _ = generic_fsm:reply(P, M), + _ = generic_fsm:reply(P, M), + _ = generic_fsm:reply(P, M), + _ = generic_fsm:reply(P, M), + _ = generic_fsm:reply(P, M), + generic_fsm_client(N+1, M, P). + +generic_fsm_transit_client(N, M, P) -> + put(?COUNTER, N), + _ = generic_fsm:transit(P, M), + _ = generic_fsm:transit(P, M), + _ = generic_fsm:transit(P, M), + _ = generic_fsm:transit(P, M), + _ = generic_fsm:transit(P, M), + generic_fsm_transit_client(N+1, M, P). + bench(simple) -> {fun simple_client/3, simple_server}; bench(simple_timer) -> @@ -380,7 +467,17 @@ bench(simple_timer_mon) -> bench(generic) -> {fun generic_client/3, generic_server}; bench(generic_timer) -> - {fun generic_timer_client/3, generic_server_timer}. + {fun generic_timer_client/3, generic_server_timer}; +bench(generic_statem) -> + {fun generic_statem_client/3, generic_statem}; +bench(generic_statem_transit) -> + {fun generic_statem_transit_client/3, generic_statem}; +bench(generic_statem_complex) -> + {fun generic_statem_complex_client/3, generic_statem_complex}; +bench(generic_fsm) -> + {fun generic_fsm_client/3, generic_fsm}; +bench(generic_fsm_transit) -> + {fun generic_fsm_transit_client/3, generic_fsm}. %% -> {Parallelism, MessageTerm} bench_params(single_small) -> {1, small()}; diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl new file mode 100644 index 0000000000..50f7df7a2a --- /dev/null +++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_fsm.erl @@ -0,0 +1,59 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017-2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(generic_fsm). + +-export([start/1, reply/2, transit/2, stop/1]). + +-export([init/1, terminate/3]). +-export([state1/3, state2/3]). + +-behaivour(gen_fsm). + + +%% API + +start(Data) -> + {ok, Pid} = gen_fsm:start(?MODULE, Data, []), + Pid. + +stop(P) -> + ok = gen_fsm:stop(P). + +reply(S, M) -> + gen_fsm:sync_send_event(S, {reply, M}, infinity). + +transit(S, M) -> + gen_fsm:sync_send_event(S, {transit, M}, infinity). + +%% Implementation + +init(Data) -> + {ok, state1, Data}. + +terminate(_Reason, _State, _Data) -> + ok. + +state1({reply, M}, _From, Data) -> + {reply, M, ?FUNCTION_NAME, Data}; +state1({transit, M}, _From, Data) -> + {reply, M, state2, Data}. + +state2({transit, M}, _From, Data) -> + {reply, M, state1, Data}. diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl new file mode 100644 index 0000000000..2e0491f060 --- /dev/null +++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem.erl @@ -0,0 +1,58 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017-2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(generic_statem). + +-export([start/1, reply/2, transit/2, stop/1]). + +-export([callback_mode/0, init/1]). +-export([state1/3, state2/3]). + +-behaviour(gen_statem). + +%% API + +start(Data) -> + {ok, Pid} = gen_statem:start(?MODULE, Data, []), + Pid. + +stop(P) -> + ok = gen_statem:stop(P). + +reply(S, M) -> + gen_statem:call(S, {reply, M}, infinity). + +transit(S, M) -> + gen_statem:call(S, {transit, M}, infinity). + +%% Implementation + +callback_mode() -> + state_functions. + +init(Data) -> + {ok, state1, Data}. + +state1({call, From}, {reply, M}, Data) -> + {keep_state, Data, {reply, From, M}}; +state1({call, From}, {transit, M}, Data) -> + {next_state, state2, Data, {reply, From, M}}. + +state2({call, From}, {transit, M}, Data) -> + {next_state, state1, Data, {reply, From, M}}. diff --git a/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem_complex.erl b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem_complex.erl new file mode 100644 index 0000000000..983227d281 --- /dev/null +++ b/lib/stdlib/test/stdlib_bench_SUITE_data/generic_statem_complex.erl @@ -0,0 +1,66 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2017-2018. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(generic_statem_complex). + +-export([start/1, reply/2, stop/1]). + +-export([callback_mode/0, init/1]). +-export([state1/3, state2/3, state3/3]). + +-behaviour(gen_statem). + +%% API + +start(Data) -> + {ok, Pid} = gen_statem:start(?MODULE, Data, []), + Pid. + +stop(P) -> + ok = gen_statem:stop(P). + +reply(S, M) -> + gen_statem:call(S, {reply, M}, infinity). + +%% Implementation + +callback_mode() -> + [state_functions,state_enter]. + +init(Data) -> + {ok, state1, Data}. + +state1(enter, _, Data) -> + {keep_state, Data, + {state_timeout, 5000, t1}}; +state1({call, _From}, {reply, _M}, Data) -> + {next_state, state2, Data, + [postpone,{next_event,internal,e}]}. + +state2(enter, _, _Data) -> + keep_state_and_data; +state2(internal, e, Data) -> + {next_state, state3, Data}. + +state3(enter, _, Data) -> + {keep_state, Data, + {state_timeout, 5000, t3}}; +state3({call, From}, {reply, M}, Data) -> + {next_state, state1, Data, + {reply, From, M}}. diff --git a/lib/wx/c_src/wxe_ps_init.c b/lib/wx/c_src/wxe_ps_init.c index e6b677d469..277f3ac25f 100644 --- a/lib/wx/c_src/wxe_ps_init.c +++ b/lib/wx/c_src/wxe_ps_init.c @@ -61,13 +61,20 @@ int is_packaged_app() { void * wxe_ps_init2() { NSAutoreleasePool *pool; ProcessSerialNumber psn; - + size_t app_len = 127; + char app_title_buf[128]; + char * app_title; // Setup and enable gui pool = [[NSAutoreleasePool alloc] init]; - + if( !is_packaged_app() ) { // Undocumented function (but no documented way of doing this exists) - char *app_title = getenv("WX_APP_TITLE"); + int res = erl_drv_getenv("WX_APP_TITLE", app_title_buf, &app_len); + if (res >= 0) { + app_title = app_title_buf; + } else { + app_title = NULL; + } if(!GetCurrentProcess(&psn)) { CPSSetProcessName(&psn, app_title?app_title:"Erlang"); } diff --git a/lib/wx/src/wxe_master.erl b/lib/wx/src/wxe_master.erl index ce859b3eb3..a55917f0aa 100644 --- a/lib/wx/src/wxe_master.erl +++ b/lib/wx/src/wxe_master.erl @@ -122,16 +122,9 @@ init([SilentStart]) -> erlang:error(not_smp) end, - case os:type() of - {win32,_} -> %% Needed for mingwm10.dll - Path = os:getenv("PATH"), - os:putenv("PATH", PrivDir ++ ";" ++ Path); - _ -> ok - end, - case erl_ddll:load_driver(PrivDir,DriverName) of ok -> ok; - {error, What} -> + {error, What} -> wxe_util:opt_error_log(SilentStart, "WX Failed loading ~p@~p ~n", [DriverName,PrivDir]), @@ -139,8 +132,8 @@ init([SilentStart]) -> erlang:error({load_driver,Str}) end, process_flag(trap_exit, true), - DriverWithArgs = DriverName ++ " " ++ code:priv_dir(wx) ++ [0], - + DriverWithArgs = DriverName ++ " " ++ code:priv_dir(wx), + try Port = open_port({spawn, DriverWithArgs},[binary]), wx_debug_info = ets:new(wx_debug_info, [named_table]), diff --git a/system/doc/design_principles/statem.xml b/system/doc/design_principles/statem.xml index a0611a46da..5be2981f62 100644 --- a/system/doc/design_principles/statem.xml +++ b/system/doc/design_principles/statem.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2016</year><year>2017</year> + <year>2016</year><year>2018</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -1679,8 +1679,8 @@ handle_event( {next_state, {open,LockButton}, Data, [{reply,From,ok}]}; [Digit|Rest] -> % Incomplete - {keep_state, Data#{remaining := Rest, 30000}, - [{reply,From,ok}]}; + {keep_state, Data#{remaining := Rest}, + [{reply,From,ok}, 30000]}; [_|_] -> % Wrong {keep_state, Data#{remaining := Code}, [{reply,From,ok}]} |