diff options
103 files changed, 2160 insertions, 702 deletions
diff --git a/bootstrap/lib/compiler/ebin/beam_bool.beam b/bootstrap/lib/compiler/ebin/beam_bool.beam Binary files differindex f339e76fce..6454719448 100644 --- a/bootstrap/lib/compiler/ebin/beam_bool.beam +++ b/bootstrap/lib/compiler/ebin/beam_bool.beam diff --git a/bootstrap/lib/compiler/ebin/beam_clean.beam b/bootstrap/lib/compiler/ebin/beam_clean.beam Binary files differindex f6a9ff987d..086720f13c 100644 --- a/bootstrap/lib/compiler/ebin/beam_clean.beam +++ b/bootstrap/lib/compiler/ebin/beam_clean.beam diff --git a/bootstrap/lib/compiler/ebin/beam_type.beam b/bootstrap/lib/compiler/ebin/beam_type.beam Binary files differindex 38c48d4075..a87320614c 100644 --- a/bootstrap/lib/compiler/ebin/beam_type.beam +++ b/bootstrap/lib/compiler/ebin/beam_type.beam diff --git a/bootstrap/lib/compiler/ebin/beam_utils.beam b/bootstrap/lib/compiler/ebin/beam_utils.beam Binary files differindex e4eb399324..db50b2a862 100644 --- a/bootstrap/lib/compiler/ebin/beam_utils.beam +++ b/bootstrap/lib/compiler/ebin/beam_utils.beam diff --git a/bootstrap/lib/compiler/ebin/beam_validator.beam b/bootstrap/lib/compiler/ebin/beam_validator.beam Binary files differindex 197a4d005c..f43adc7293 100644 --- a/bootstrap/lib/compiler/ebin/beam_validator.beam +++ b/bootstrap/lib/compiler/ebin/beam_validator.beam diff --git a/bootstrap/lib/compiler/ebin/core_lib.beam b/bootstrap/lib/compiler/ebin/core_lib.beam Binary files differindex bb38837049..54f43c6c10 100644 --- a/bootstrap/lib/compiler/ebin/core_lib.beam +++ b/bootstrap/lib/compiler/ebin/core_lib.beam diff --git a/bootstrap/lib/compiler/ebin/core_parse.beam b/bootstrap/lib/compiler/ebin/core_parse.beam Binary files differindex 121ef65275..9d8b86bee2 100644 --- a/bootstrap/lib/compiler/ebin/core_parse.beam +++ b/bootstrap/lib/compiler/ebin/core_parse.beam diff --git a/bootstrap/lib/compiler/ebin/erl_bifs.beam b/bootstrap/lib/compiler/ebin/erl_bifs.beam Binary files differindex 27136581c1..d6c4dec85e 100644 --- a/bootstrap/lib/compiler/ebin/erl_bifs.beam +++ b/bootstrap/lib/compiler/ebin/erl_bifs.beam diff --git a/bootstrap/lib/compiler/ebin/sys_core_fold.beam b/bootstrap/lib/compiler/ebin/sys_core_fold.beam Binary files differindex cce0ac7832..5a091fac34 100644 --- a/bootstrap/lib/compiler/ebin/sys_core_fold.beam +++ b/bootstrap/lib/compiler/ebin/sys_core_fold.beam diff --git a/bootstrap/lib/kernel/ebin/kernel.appup b/bootstrap/lib/kernel/ebin/kernel.appup index 02cf129b42..3ff5aa73f0 100644 --- a/bootstrap/lib/kernel/ebin/kernel.appup +++ b/bootstrap/lib/kernel/ebin/kernel.appup @@ -15,7 +15,7 @@ %% under the License. %% %% %CopyrightEnd% -{"3.0.3", +{"3.1", %% Up from - max one major revision back [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-17 %% Down to - max one major revision back diff --git a/bootstrap/lib/stdlib/ebin/erl_lint.beam b/bootstrap/lib/stdlib/ebin/erl_lint.beam Binary files differindex 57f7280766..d6421a4759 100644 --- a/bootstrap/lib/stdlib/ebin/erl_lint.beam +++ b/bootstrap/lib/stdlib/ebin/erl_lint.beam diff --git a/bootstrap/lib/stdlib/ebin/erl_parse.beam b/bootstrap/lib/stdlib/ebin/erl_parse.beam Binary files differindex 8c83dcd4ba..373eaef459 100644 --- a/bootstrap/lib/stdlib/ebin/erl_parse.beam +++ b/bootstrap/lib/stdlib/ebin/erl_parse.beam diff --git a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam Binary files differindex 68ec08365e..8aafd0fd1e 100644 --- a/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam +++ b/bootstrap/lib/stdlib/ebin/io_lib_pretty.beam diff --git a/bootstrap/lib/stdlib/ebin/math.beam b/bootstrap/lib/stdlib/ebin/math.beam Binary files differindex c2e8dfb874..b4596ee515 100644 --- a/bootstrap/lib/stdlib/ebin/math.beam +++ b/bootstrap/lib/stdlib/ebin/math.beam diff --git a/bootstrap/lib/stdlib/ebin/stdlib.appup b/bootstrap/lib/stdlib/ebin/stdlib.appup index 541b1925e5..37251e8e2d 100644 --- a/bootstrap/lib/stdlib/ebin/stdlib.appup +++ b/bootstrap/lib/stdlib/ebin/stdlib.appup @@ -15,7 +15,7 @@ %% under the License. %% %% %CopyrightEnd% -{"2.2", +{"2.3", %% Up from - max one major revision back [{<<"2\\.[1-2](\\.[0-9]+)*">>,[restart_new_emulator]}, %% 17.1-17.3 {<<"2\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}], %% 17.0 diff --git a/erts/configure.in b/erts/configure.in index b3fe48d62c..7cb6b50708 100644 --- a/erts/configure.in +++ b/erts/configure.in @@ -4905,6 +4905,11 @@ LDFLAGS="$LDFLAGS $sanitizers" ]) dnl ---------------------------------------------------------------------- +dnl Check for log2 +dnl ---------------------------------------------------------------------- +AC_CHECK_FUNCS([log2]) + +dnl ---------------------------------------------------------------------- dnl Output the result. dnl ---------------------------------------------------------------------- diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index aea3224342..1d0d214e77 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -194,6 +194,7 @@ bif math:erf/1 bif math:erfc/1 bif math:exp/1 bif math:log/1 +bif math:log2/1 bif math:log10/1 bif math:sqrt/1 bif math:atan2/2 diff --git a/erts/emulator/beam/erl_math.c b/erts/emulator/beam/erl_math.c index 16d4fdc09c..9b864628db 100644 --- a/erts/emulator/beam/erl_math.c +++ b/erts/emulator/beam/erl_math.c @@ -207,6 +207,24 @@ BIF_RETTYPE math_log_1(BIF_ALIST_1) return math_call_1(BIF_P, log, BIF_ARG_1); } +#ifdef HAVE_LOG2 +static double +log2_wrapper(double x) +{ + return log2(x); +} +#else +static double +log2_wrapper(double x) +{ + return log(x) / 0.6931471805599453; /* log(2.0); */ +} +#endif + +BIF_RETTYPE math_log2_1(BIF_ALIST_1) +{ + return math_call_1(BIF_P, log2_wrapper, BIF_ARG_1); +} BIF_RETTYPE math_log10_1(BIF_ALIST_1) { diff --git a/erts/emulator/hipe/hipe_arm_bifs.m4 b/erts/emulator/hipe/hipe_arm_bifs.m4 index 57e51bb8b1..884240be9c 100644 --- a/erts/emulator/hipe/hipe_arm_bifs.m4 +++ b/erts/emulator/hipe/hipe_arm_bifs.m4 @@ -26,6 +26,7 @@ include(`hipe/hipe_arm_asm.m4') .text .p2align 2 + .arm `#if defined(ERTS_ENABLE_LOCK_CHECK) && defined(ERTS_SMP) # define CALL_BIF(F) ldr r14, =F; str r14, [r0, #P_BIF_CALLEE]; bl hipe_debug_bif_wrapper @@ -392,7 +393,14 @@ $1: mov r0, P /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(0) +#else QUICK_CALL_RET($2,0) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -408,7 +416,14 @@ $1: NBIF_ARG(r1,1,0) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(1) +#else QUICK_CALL_RET($2,1) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -425,7 +440,14 @@ $1: NBIF_ARG(r2,2,1) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(2) +#else QUICK_CALL_RET($2,2) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -443,7 +465,14 @@ $1: NBIF_ARG(r3,3,2) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(3) +#else QUICK_CALL_RET($2,3) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -467,7 +496,14 @@ $1: NBIF_ARG(r3,5,2) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(5) +#else QUICK_CALL_RET($2,5) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -489,9 +525,16 @@ define(noproc_primop_interface_0, #`define' HAVE_$1 .global $1 $1: - /* XXX: this case is always trivial; how to suppress the branch? */ /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(0) +#else + /* XXX: this case is always trivial; how to suppress the branch? */ QUICK_CALL_RET($2,0) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -506,7 +549,14 @@ $1: NBIF_ARG(r0,1,0) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(1) +#else QUICK_CALL_RET($2,1) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -522,7 +572,14 @@ $1: NBIF_ARG(r1,2,1) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(2) +#else QUICK_CALL_RET($2,2) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -539,7 +596,14 @@ $1: NBIF_ARG(r2,3,2) /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(3) +#else QUICK_CALL_RET($2,3) +#endif .size $1, .-$1 .type $1, %function #endif') @@ -559,7 +623,14 @@ $1: str r4, [sp, #0] /* Perform a quick save;call;restore;ret sequence. */ +#ifdef __thumb__ + SAVE_CONTEXT_QUICK + bl $2 + RESTORE_CONTEXT_QUICK + NBIF_RET(5) +#else QUICK_CALL_RET($2,5) +#endif .size $1, .-$1 .type $1, %function #endif') diff --git a/erts/emulator/hipe/hipe_arm_glue.S b/erts/emulator/hipe/hipe_arm_glue.S index 069cb4512e..e7ff267606 100644 --- a/erts/emulator/hipe/hipe_arm_glue.S +++ b/erts/emulator/hipe/hipe_arm_glue.S @@ -24,6 +24,7 @@ .text .p2align 2 + .arm /* * Enter Erlang from C. @@ -69,6 +70,7 @@ * Emulated code recursively calls native code. */ .global hipe_arm_call_to_native + .type hipe_arm_call_to_native, %function hipe_arm_call_to_native: ENTER_FROM_C /* get argument registers */ @@ -84,6 +86,7 @@ hipe_arm_call_to_native: * This is where native code returns to emulated code. */ .global nbif_return + .type nbif_return, %function nbif_return: str r0, [P, #P_ARG0] /* save retval */ mov r0, #HIPE_MODE_SWITCH_RES_RETURN @@ -94,6 +97,7 @@ nbif_return: * Emulated code returns to its native code caller. */ .global hipe_arm_return_to_native + .type hipe_arm_return_to_native, %function hipe_arm_return_to_native: ENTER_FROM_C /* get return value */ @@ -110,6 +114,7 @@ hipe_arm_return_to_native: * Emulated code tailcalls native code. */ .global hipe_arm_tailcall_to_native + .type hipe_arm_tailcall_to_native, %function hipe_arm_tailcall_to_native: ENTER_FROM_C /* get argument registers */ @@ -124,6 +129,7 @@ hipe_arm_tailcall_to_native: * Emulated code throws an exception to its native code caller. */ .global hipe_arm_throw_to_native + .type hipe_arm_throw_to_native, %function hipe_arm_throw_to_native: ENTER_FROM_C /* invoke the handler */ @@ -141,6 +147,7 @@ hipe_arm_throw_to_native: * XXX: Different stubs for different number of register parameters? */ .global nbif_callemu + .type nbif_callemu, %function nbif_callemu: str r8, [P, #P_CALLEE_EXP] str r0, [P, #P_ARITY] @@ -152,6 +159,7 @@ nbif_callemu: * nbif_apply */ .global nbif_apply + .type nbif_apply, %function nbif_apply: STORE_ARG_REGS mov r0, #HIPE_MODE_SWITCH_RES_APPLY @@ -168,6 +176,7 @@ nbif_apply: */ #if NR_ARG_REGS >= 6 .global nbif_ccallemu6 + .type nbif_ccallemu6, %function nbif_ccallemu6: str ARG5, [P, #P_ARG5] #if NR_ARG_REGS > 6 @@ -180,6 +189,7 @@ nbif_ccallemu6: #if NR_ARG_REGS >= 5 .global nbif_ccallemu5 + .type nbif_ccallemu5, %function nbif_ccallemu5: str ARG4, [P, #P_ARG4] #if NR_ARG_REGS > 5 @@ -192,6 +202,7 @@ nbif_ccallemu5: #if NR_ARG_REGS >= 4 .global nbif_ccallemu4 + .type nbif_ccallemu4, %function nbif_ccallemu4: str ARG3, [P, #P_ARG3] #if NR_ARG_REGS > 4 @@ -204,6 +215,7 @@ nbif_ccallemu4: #if NR_ARG_REGS >= 3 .global nbif_ccallemu3 + .type nbif_ccallemu3, %function nbif_ccallemu3: str ARG2, [P, #P_ARG2] #if NR_ARG_REGS > 3 @@ -216,6 +228,7 @@ nbif_ccallemu3: #if NR_ARG_REGS >= 2 .global nbif_ccallemu2 + .type nbif_ccallemu2, %function nbif_ccallemu2: str ARG1, [P, #P_ARG1] #if NR_ARG_REGS > 2 @@ -228,6 +241,7 @@ nbif_ccallemu2: #if NR_ARG_REGS >= 1 .global nbif_ccallemu1 + .type nbif_ccallemu1, %function nbif_ccallemu1: str ARG0, [P, #P_ARG0] #if NR_ARG_REGS > 1 @@ -239,6 +253,7 @@ nbif_ccallemu1: #endif .global nbif_ccallemu0 + .type nbif_ccallemu0, %function nbif_ccallemu0: /* We use r1 not ARG0 here because ARG0 is not defined when NR_ARG_REGS == 0. */ @@ -253,6 +268,7 @@ nbif_ccallemu0: * This is where native code suspends. */ .global nbif_suspend_0 + .type nbif_suspend_0, %function nbif_suspend_0: mov r0, #HIPE_MODE_SWITCH_RES_SUSPEND b .suspend_exit @@ -261,6 +277,7 @@ nbif_suspend_0: * Suspend from a receive (waiting for a message) */ .global nbif_suspend_msg + .type nbif_suspend_msg, %function nbif_suspend_msg: mov r0, #HIPE_MODE_SWITCH_RES_WAIT b .suspend_exit @@ -271,6 +288,7 @@ nbif_suspend_msg: * else { return 0; } */ .global nbif_suspend_msg_timeout + .type nbif_suspend_msg_timeout, %function nbif_suspend_msg_timeout: ldr r1, [P, #P_FLAGS] mov r0, #HIPE_MODE_SWITCH_RES_WAIT_TIMEOUT @@ -285,23 +303,31 @@ nbif_suspend_msg_timeout: * This is the default exception handler for native code. */ .global nbif_fail + .type nbif_fail, %function nbif_fail: mov r0, #HIPE_MODE_SWITCH_RES_THROW b .flush_exit /* no need to save RA */ .global nbif_0_gc_after_bif - .global nbif_1_gc_after_bif - .global nbif_2_gc_after_bif - .global nbif_3_gc_after_bif + .type nbif_0_gc_after_bif, %function nbif_0_gc_after_bif: mov r1, #0 b .gc_after_bif + + .global nbif_1_gc_after_bif + .type nbif_1_gc_after_bif, %function nbif_1_gc_after_bif: mov r1, #1 b .gc_after_bif + + .global nbif_2_gc_after_bif + .type nbif_2_gc_after_bif, %function nbif_2_gc_after_bif: mov r1, #2 b .gc_after_bif + + .global nbif_3_gc_after_bif + .type nbif_3_gc_after_bif, %function nbif_3_gc_after_bif: mov r1, #3 /*FALLTHROUGH*/ @@ -329,18 +355,25 @@ nbif_3_gc_after_bif: * TEMP_LR contains a copy of LR */ .global nbif_0_simple_exception + .type nbif_0_simple_exception, %function nbif_0_simple_exception: mov r1, #0 b .nbif_simple_exception + .global nbif_1_simple_exception + .type nbif_1_simple_exception, %function nbif_1_simple_exception: mov r1, #1 b .nbif_simple_exception + .global nbif_2_simple_exception + .type nbif_2_simple_exception, %function nbif_2_simple_exception: mov r1, #2 b .nbif_simple_exception + .global nbif_3_simple_exception + .type nbif_3_simple_exception, %function nbif_3_simple_exception: mov r1, #3 /*FALLTHROUGH*/ @@ -384,6 +417,7 @@ nbif_3_simple_exception: * the gray/white stack boundary */ .global nbif_stack_trap_ra + .type nbif_stack_trap_ra, %function nbif_stack_trap_ra: /* a return address, not a function */ # This only handles a single return value. # If we have more, we need to save them in the PCB. @@ -400,6 +434,7 @@ nbif_stack_trap_ra: /* a return address, not a function */ * Caller saved its LR in TEMP_LR (== TEMP1) before calling us. */ .global hipe_arm_inc_stack + .type hipe_arm_inc_stack, %function hipe_arm_inc_stack: STORE_ARG_REGS mov TEMP_ARG0, lr diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 4f528b6f95..91820e08de 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -1585,7 +1585,7 @@ do_combine_put_bits(_, _, _) -> throw(impossible). debit(Budget0, Alternatives) -> - case Budget0 - log2(Alternatives) of + case Budget0 - math:log2(Alternatives) of Budget when Budget > 0.0 -> Budget; _ -> @@ -1598,8 +1598,6 @@ num_clauses([_|T], N) -> num_clauses(T, N+1); num_clauses([], N) -> N. -log2(N) -> - math:log(N) / math:log(2.0). collect_put_bits(Imm) -> lists:splitwith(fun({put_bits,V,_,_}) when is_integer(V) -> true; diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl index 5626aa34ab..7d65dc983a 100644 --- a/lib/compiler/src/beam_block.erl +++ b/lib/compiler/src/beam_block.erl @@ -155,7 +155,7 @@ collect(remove_message) -> {set,[],[],remove_message}; collect({put_map,F,Op,S,D,R,{list,Puts}}) -> {set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}; collect({get_map_elements,F,S,{list,Gets}}) -> - {Ss,Ds} = beam_utils:spliteven(Gets), + {Ss,Ds} = beam_utils:split_even(Gets), {set,Ds,[S|Ss],{get_map_elements,F}}; collect({'catch',R,L}) -> {set,[R],[],{'catch',L}}; collect(fclearerror) -> {set,[],[],fclearerror}; diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index 5a4621dc37..a452d30b61 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -126,44 +126,53 @@ bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> %% There was a reference to a boolean expression %% from inside a protected block (try/catch), to %% a boolean expression outside. - throw:protected_barrier -> + throw:protected_barrier -> failed; - %% The 'xor' operator was used. We currently don't - %% find it worthwile to translate 'xor' operators - %% (the code would be clumsy). - throw:'xor' -> + %% The 'xor' operator was used. We currently don't + %% find it worthwile to translate 'xor' operators + %% (the code would be clumsy). + throw:'xor' -> failed; - %% The block does not contain a boolean expression, - %% but only a call to a guard BIF. - %% For instance: ... when element(1, T) -> - throw:not_boolean_expr -> + %% The block does not contain a boolean expression, + %% but only a call to a guard BIF. + %% For instance: ... when element(1, T) -> + throw:not_boolean_expr -> failed; - %% The block contains a 'move' instruction that could - %% not be handled. - throw:move -> + %% The block contains a 'move' instruction that could + %% not be handled. + throw:move -> failed; - %% The optimization is not safe. (A register - %% used by the instructions following the - %% optimized code is either not assigned a - %% value at all or assigned a different value.) - throw:all_registers_not_killed -> + %% The optimization is not safe. (A register + %% used by the instructions following the + %% optimized code is either not assigned a + %% value at all or assigned a different value.) + throw:all_registers_not_killed -> failed; - throw:registers_used -> + throw:registers_used -> failed; - %% A protected block refered to the value - %% returned by another protected block, - %% probably because the Core Erlang code - %% used nested try/catches in the guard. - %% (v3_core never produces nested try/catches - %% in guards, so it must have been another - %% Core Erlang translator.) - throw:protected_violation -> + %% A protected block refered to the value + %% returned by another protected block, + %% probably because the Core Erlang code + %% used nested try/catches in the guard. + %% (v3_core never produces nested try/catches + %% in guards, so it must have been another + %% Core Erlang translator.) + throw:protected_violation -> + failed; + + %% Failed to work out the live registers for a GC + %% BIF. For example, if the number of live registers + %% needed to be 4 because {x,3} was a source register, + %% but {x,2} was not known to be initialized, this + %% exception would be thrown. + throw:gc_bif_alloc_failure -> failed + end end. @@ -665,10 +674,16 @@ put_reg_1(V, [], I) -> [{I,V}]. fetch_reg(V, [{I,V}|_]) -> {x,I}; fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs). -live_regs(Regs) -> - foldl(fun ({I,_}, _) -> - I - end, -1, Regs)+1. +live_regs([{_,reserved}|_]) -> + %% We are not sure that this register is initialized, so we must + %% abort the optimization. + throw(gc_bif_alloc_failure); +live_regs([{I,_}]) -> + I+1; +live_regs([{_,_}|Regs]) -> + live_regs(Regs); +live_regs([]) -> + 0. %%% diff --git a/lib/compiler/src/beam_clean.erl b/lib/compiler/src/beam_clean.erl index b653998252..b68b8702e0 100644 --- a/lib/compiler/src/beam_clean.erl +++ b/lib/compiler/src/beam_clean.erl @@ -234,31 +234,6 @@ replace([{bs_init,{f,Lbl},Info,Live,Ss,Dst}|Is], Acc, D) when Lbl =/= 0 -> replace(Is, [{bs_init,{f,label(Lbl, D)},Info,Live,Ss,Dst}|Acc], D); replace([{bs_put,{f,Lbl},Info,Ss}|Is], Acc, D) when Lbl =/= 0 -> replace(Is, [{bs_put,{f,label(Lbl, D)},Info,Ss}|Acc], D); -replace([{bs_init2,{f,Lbl},Sz,Words,R,F,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_init2,{f,label(Lbl, D)},Sz,Words,R,F,Dst}|Acc], D); -replace([{bs_init_bits,{f,Lbl},Sz,Words,R,F,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_init_bits,{f,label(Lbl, D)},Sz,Words,R,F,Dst}|Acc], D); -replace([{bs_put_integer,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put_integer,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); -replace([{bs_put_utf8=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); -replace([{bs_put_utf16=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); -replace([{bs_put_utf32=I,{f,Lbl},Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Fl,Val}|Acc], D); -replace([{bs_put_binary,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put_binary,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); -replace([{bs_put_float,{f,Lbl},Bits,Unit,Fl,Val}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_put_float,{f,label(Lbl, D)},Bits,Unit,Fl,Val}|Acc], D); -replace([{bs_add,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{bs_add,{f,label(Lbl, D)},Src,Dst}|Acc], D); -replace([{bs_append,{f,Lbl},_,_,_,_,_,_,_}=I0|Is], Acc, D) when Lbl =/= 0 -> - I = setelement(2, I0, {f,label(Lbl, D)}), - replace(Is, [I|Acc], D); -replace([{bs_utf8_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D); -replace([{bs_utf16_size=I,{f,Lbl},Src,Dst}|Is], Acc, D) when Lbl =/= 0 -> - replace(Is, [{I,{f,label(Lbl, D)},Src,Dst}|Acc], D); replace([{put_map=I,{f,Lbl},Op,Src,Dst,Live,List}|Is], Acc, D) when Lbl =/= 0 -> replace(Is, [{I,{f,label(Lbl, D)},Op,Src,Dst,Live,List}|Acc], D); diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl index 05d067dc48..54e06df995 100644 --- a/lib/compiler/src/beam_flatten.erl +++ b/lib/compiler/src/beam_flatten.erl @@ -63,9 +63,7 @@ norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I}; norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2}; norm({set,[D],[S|Puts],{alloc,R,{put_map,Op,F}}}) -> {put_map,F,Op,S,D,R,{list,Puts}}; -norm({set,Ds,[S|Ss],{get_map_elements,F}}) -> - Gets = beam_utils:joineven(Ss,Ds), - {get_map_elements,F,S,{list,Gets}}; +%% get_map_elements is always handled in beam_split (moved out of block) norm({set,[],[],remove_message}) -> remove_message; norm({set,[],[],fclearerror}) -> fclearerror; norm({set,[],[],fcheckerror}) -> {fcheckerror,{f,0}}. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index b952139f2c..4e699c4fbf 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -435,14 +435,14 @@ is_label_used_in(Lbl, Is) -> is_label_used_in_1(Is, Lbl, gb_sets:empty()). is_label_used_in_1([{block,Block}|Is], Lbl, Empty) -> - lists:any(fun(I) -> is_label_used_in_2(I, Lbl) end, Block) + lists:any(fun(I) -> is_label_used_in_block(I, Lbl) end, Block) orelse is_label_used_in_1(Is, Lbl, Empty); is_label_used_in_1([I|Is], Lbl, Empty) -> Used = ulbl(I, Empty), gb_sets:is_member(Lbl, Used) orelse is_label_used_in_1(Is, Lbl, Empty); is_label_used_in_1([], _, _) -> false. -is_label_used_in_2({set,_,_,Info}, Lbl) -> +is_label_used_in_block({set,_,_,Info}, Lbl) -> case Info of {bif,_,{f,F}} -> F =:= Lbl; {alloc,_,{gc_bif,_,{f,F}}} -> F =:= Lbl; @@ -452,7 +452,6 @@ is_label_used_in_2({set,_,_,Info}, Lbl) -> {put_tuple,_} -> false; {get_tuple_element,_} -> false; {set_tuple_element,_} -> false; - {get_map_elements,{f,F}} -> F =:= Lbl; {line,_} -> false; _ when is_atom(Info) -> false end. diff --git a/lib/compiler/src/beam_split.erl b/lib/compiler/src/beam_split.erl index f5dba314ae..0c62b0bf3d 100644 --- a/lib/compiler/src/beam_split.erl +++ b/lib/compiler/src/beam_split.erl @@ -53,9 +53,8 @@ split_block([{set,[D],[S|Puts],{alloc,R,{put_map,Op,{f,Lbl}=Fail}}}|Is], Bl, Acc) when Lbl =/= 0 -> split_block(Is, [], [{put_map,Fail,Op,S,D,R,{list,Puts}}| make_block(Bl, Acc)]); -split_block([{set,Ds,[S|Ss],{get_map_elements,{f,Lbl}=Fail}}|Is], Bl, Acc) - when Lbl =/= 0 -> - Gets = beam_utils:joineven(Ss,Ds), +split_block([{set,Ds,[S|Ss],{get_map_elements,Fail}}|Is], Bl, Acc) -> + Gets = beam_utils:join_even(Ss,Ds), split_block(Is, [], [{get_map_elements,Fail,S,{list,Gets}}|make_block(Bl, Acc)]); split_block([{set,[R],[],{'catch',L}}|Is], Bl, Acc) -> split_block(Is, [], [{'catch',R,L}|make_block(Bl, Acc)]); diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index cdddad4153..d9713cef0d 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -469,6 +469,7 @@ is_math_bif(erf, 1) -> true; is_math_bif(erfc, 1) -> true; is_math_bif(exp, 1) -> true; is_math_bif(log, 1) -> true; +is_math_bif(log2, 1) -> true; is_math_bif(log10, 1) -> true; is_math_bif(sqrt, 1) -> true; is_math_bif(atan2, 2) -> true; diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index e82ba82d38..26020e1d29 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -26,7 +26,7 @@ code_at/2,bif_to_test/3,is_pure_test/1, live_opt/1,delete_live_annos/1,combine_heap_needs/2]). --export([joineven/2,spliteven/1]). +-export([join_even/2,split_even/1]). -import(lists, [member/2,sort/1,reverse/1,splitwith/2]). @@ -758,13 +758,9 @@ live_opt([{line,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); %% The following instructions can occur if the "compilation" has been -%% started from a .S file using the 'asm' option. +%% started from a .S file using the 'from_asm' option. live_opt([{trim,_,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); -live_opt([{allocate,_,Live}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Live), D, [I|Acc]); -live_opt([{allocate_heap,_,_,Live}=I|Is], _, D, Acc) -> - live_opt(Is, live_call(Live), D, [I|Acc]); live_opt([{'%',_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{recv_set,_}=I|Is], Regs, D, Acc) -> @@ -835,14 +831,14 @@ x_live([], Regs) -> Regs. is_live(X, Regs) -> ((Regs bsr X) band 1) =:= 1. -%% spliteven/1 +%% split_even/1 %% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]} -spliteven(Rs) -> spliteven(Rs,[],[]). -spliteven([],Ss,Ds) -> {reverse(Ss),reverse(Ds)}; -spliteven([S,D|Rs],Ss,Ds) -> - spliteven(Rs,[S|Ss],[D|Ds]). +split_even(Rs) -> split_even(Rs,[],[]). +split_even([],Ss,Ds) -> {reverse(Ss),reverse(Ds)}; +split_even([S,D|Rs],Ss,Ds) -> + split_even(Rs,[S|Ss],[D|Ds]). -%% joineven/1 +%% join_even/1 %% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6] -joineven([],[]) -> []; -joineven([S|Ss],[D|Ds]) -> [S,D|joineven(Ss,Ds)]. +join_even([],[]) -> []; +join_even([S|Ss],[D|Ds]) -> [S,D|join_even(Ss,Ds)]. diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 0acc7a227f..c156cf79fe 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1818,6 +1818,7 @@ return_type_math(erf, 1) -> {float,[]}; return_type_math(erfc, 1) -> {float,[]}; return_type_math(exp, 1) -> {float,[]}; return_type_math(log, 1) -> {float,[]}; +return_type_math(log2, 1) -> {float,[]}; return_type_math(log10, 1) -> {float,[]}; return_type_math(sqrt, 1) -> {float,[]}; return_type_math(atan2, 2) -> {float,[]}; diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index 2792fd8fa5..0d95971f91 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -212,6 +212,8 @@ vu_pattern(V, #c_tuple{es=Es}, St) -> vu_pattern_list(V, Es, St); vu_pattern(V, #c_binary{segments=Ss}, St) -> vu_pat_seg_list(V, Ss, St); +vu_pattern(V, #c_map{es=Es}, St) -> + vu_map_pairs(V, Es, St); vu_pattern(V, #c_alias{var=Var,pat=P}, St0) -> case vu_pattern(V, Var, St0) of {true,_}=St1 -> St1; @@ -234,6 +236,13 @@ vu_pat_seg_list(V, Ss, St) -> end end, St, Ss). +vu_map_pairs(V, [#c_map_pair{val=Pat}|T], St0) -> + case vu_pattern(V, Pat, St0) of + {true,_}=St -> St; + St -> vu_map_pairs(V, T, St) + end; +vu_map_pairs(_, [], St) -> St. + -spec vu_var_list(cerl:var_name(), [cerl:c_var()]) -> boolean(). vu_var_list(V, Vs) -> diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl index 6c75538194..bcc2297250 100644 --- a/lib/compiler/src/erl_bifs.erl +++ b/lib/compiler/src/erl_bifs.erl @@ -134,6 +134,7 @@ is_pure(math, erf, 1) -> true; is_pure(math, erfc, 1) -> true; is_pure(math, exp, 1) -> true; is_pure(math, log, 1) -> true; +is_pure(math, log2, 1) -> true; is_pure(math, log10, 1) -> true; is_pure(math, pow, 2) -> true; is_pure(math, sin, 1) -> true; diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 82817a987a..09716d0866 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -2072,17 +2072,47 @@ maybe_replace_var_1(E, #sub{t=Tdb}) -> false -> E; true -> - cerl_trees:map(fun(C) -> - case cerl:is_c_alias(C) of - false -> C; - true -> cerl:alias_pat(C) - end - end, T0) + %% The pattern was a tuple. Now we must make sure + %% that the elements of the tuple are suitable. In + %% particular, we don't want binary or map + %% construction here, since that means that the + %% binary or map will be constructed in the 'case' + %% argument. That is wasteful for binaries. Even + %% worse is that any map pattern that use the ':=' + %% operator will fail when used in map + %% construction (only the '=>' operator is allowed + %% when constructing a map from scratch). + ToData = fun coerce_to_data/1, + try + cerl_trees:map(ToData, T0) + catch + throw:impossible -> + %% Something unsuitable was found (map or + %% or binary). Keep the variable. + E + end end; error -> E end. +%% coerce_to_data(Core) -> Core' +%% Coerce an element originally from a pattern to an data item or or +%% variable. Throw an 'impossible' exception if non-data Core Erlang +%% terms such as binary construction or map construction are +%% encountered. + +coerce_to_data(C) -> + case cerl:is_c_alias(C) of + false -> + case cerl:is_data(C) orelse cerl:is_c_var(C) of + true -> C; + false -> throw(impossible) + end; + true -> + coerce_to_data(cerl:alias_pat(C)) + end. + %% case_opt_lit(Literal, Clauses0, LitExpr) -> %% {ok,[],Clauses} | error %% The current part of the case expression is a literal. That diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 892a401c75..73d52a48bc 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -11,6 +11,7 @@ MODULES= \ beam_validator_SUITE \ beam_disasm_SUITE \ beam_except_SUITE \ + beam_utils_SUITE \ bs_bincomp_SUITE \ bs_bit_binaries_SUITE \ bs_construct_SUITE \ @@ -40,6 +41,7 @@ NO_OPT= \ andor \ apply \ beam_except \ + beam_utils \ bs_construct \ bs_match \ bs_utf \ @@ -59,6 +61,7 @@ NO_OPT= \ INLINE= \ andor \ apply \ + beam_utils \ bs_bincomp \ bs_bit_binaries \ bs_construct \ diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl new file mode 100644 index 0000000000..9142ca6485 --- /dev/null +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -0,0 +1,236 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(beam_utils_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + apply_fun/1,apply_mf/1,bs_init/1,bs_save/1, + is_not_killed/1,is_not_used_at/1, + select/1,y_catch/1]). +-export([id/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,test_lib:parallel(), + [apply_fun, + apply_mf, + bs_init, + bs_save, + is_not_killed, + is_not_used_at, + select, + y_catch + ]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +apply_fun(_Config) -> + 3 = do_apply_fun(false, false), + 3 = do_apply_fun(false, true), + 3 = do_apply_fun(true, false), + 2 = do_apply_fun(true, true), + ok. + +do_apply_fun(X, Y) -> + F = fun(I) -> I+1 end, + Arg = case X andalso id(Y) of + true -> 1; + false -> 2 + end, + F(Arg). + +apply_mf(_Config) -> + ok = do_apply_mf_used({a,b}, ?MODULE, id), + error = do_apply_mf_used([a], ?MODULE, id), + {'EXIT',{{case_clause,{[],b}},_}} = (catch do_apply_mf_used({[],b}, ?MODULE, id)), + + error = do_apply_mf_killed({error,[a]}, ?MODULE, id), + ok = do_apply_mf_killed([b], ?MODULE, id), + {'EXIT',{{case_clause,{a,[b]}},_}} = (catch do_apply_mf_killed({a,[b]}, ?MODULE, id)), + {'EXIT',{{case_clause,{error,[]}},_}} = (catch do_apply_mf_killed({error,[]}, ?MODULE, id)), + + ok. + +do_apply_mf_used(Arg, Mod, Func) -> + Res = case id(Arg) of + {Decoded,_} when Decoded =/= [] -> + ok; + List when is_list(List) -> + error + end, + Mod:Func(Res). + +do_apply_mf_killed(Arg, Mod, Func) -> + Res = case id(Arg) of + {Tag,Decoded} when Decoded =/= [], Tag =:= error -> + error; + List when is_list(List) -> + ok + end, + Mod:Func(Res). + +bs_init(_Config) -> + <<7>> = do_bs_init_1([?MODULE], 7), + error = do_bs_init_1([?MODULE], 0.0), + error = do_bs_init_1([?MODULE], -43), + error = do_bs_init_1([?MODULE], 42), + + <<>> = do_bs_init_2([]), + <<0:32,((1 bsl 32)-1):32>> = do_bs_init_2([0,(1 bsl 32)-1]), + {'EXIT',{badarg,_}} = (catch do_bs_init_2([0.5])), + {'EXIT',{badarg,_}} = (catch do_bs_init_2([-1])), + {'EXIT',{badarg,_}} = (catch do_bs_init_2([1 bsl 32])), + ok. + +do_bs_init_1([?MODULE], Sz) -> + if + is_integer(Sz), Sz >= -42, Sz < 42 -> + id(<<Sz:8>>); + true -> + error + end. + +do_bs_init_2(SigNos) -> + << <<SigNo:32>> || + SigNo <- SigNos, + (is_integer(SigNo) andalso SigNo >= 0 andalso SigNo < (1 bsl 32)) orelse + erlang:error(badarg) + >>. + + +bs_save(_Config) -> + {a,30,<<>>} = do_bs_save(<<1:1,30:5>>), + {b,127,<<>>} = do_bs_save(<<1:1,31:5,0:1,127:7>>), + {c,127,<<>>} = do_bs_save(<<1:1,31:5,1:1,127:7>>), + {c,127,<<>>} = do_bs_save(<<0:1,31:5,1:1,127:7>>), + {d,1024,<<>>} = do_bs_save(<<0:1,31:5>>), + ok. + +do_bs_save(<<_:1, Tag:5, T/binary>>) when Tag < 31 -> + {a,Tag,T}; +do_bs_save(<<1:1, 31:5, 0:1, Tag:7, T/binary>>) -> + {b,Tag,T}; +do_bs_save(<<_:1, 31:5, 1:1, Tag:7, T/binary>>) -> + {c,Tag,T}; +do_bs_save(<<_:1, 31:5, T/binary>>) -> + {d,1024,T}. + +is_not_killed(_Config) -> + {Pid,Ref} = spawn_monitor(fun() -> exit(banan) end), + receive + {'DOWN', Ref, process, Pid, banan} -> + ok + end, + receive after 0 -> ok end. + +is_not_used_at(_Config) -> + {a,b} = do_is_not_used_at(a, [{a,b}]), + {a,b} = do_is_not_used_at(a, [x,{a,b}]), + {a,b} = do_is_not_used_at(a, [{x,y},{a,b}]), + none = do_is_not_used_at(z, [{a,b}]), + none = do_is_not_used_at(a, [x]), + none = do_is_not_used_at(a, [{x,y}]), + ok. + +do_is_not_used_at(Key, [P|Ps]) -> + if + tuple_size(P) >= 1, element(1, P) =:= Key -> + P; + true -> + do_is_not_used_at(Key, Ps) + end; +do_is_not_used_at(_Key, []) -> none. + +-record(select, {fixed=false}). + +select(_Config) -> + a = do_select(#select{}, 0, 0), + b = do_select(#select{}, 0, 1), + c = do_select(#select{fixed=true}, 0, 0), + c = do_select(#select{fixed=true}, 0, 1), + ok. + +do_select(Head, OldSize, BSize) -> + Overwrite0 = + if + OldSize =:= BSize -> same; + true -> true + end, + Overwrite = + if + Head#select.fixed =/= false -> + false; + true -> + Overwrite0 + end, + if + Overwrite =:= same -> + a; + Overwrite -> + b; + true -> + c + end. + +y_catch(_Config) -> + ok = try + do_y_catch(<<"<?xmlX">>, {state}), + failed + catch + throw:{<<"<?xmlX">>,{state}} -> + ok + end. + +do_y_catch(<<"<?xml",Rest0/binary>> = Bytes, State0) -> + {Rest1,State1} = + case do_y_catch_1(Rest0, State0) of + false -> + {Bytes,State0}; + true -> + {_XmlAttributes, R, S} = do_y_catch_2(Rest0), + {R,S} + end, + case catch id({Rest1,State1}) of + Other -> + throw(Other) + end. + +do_y_catch_1(<<_,_/binary>>, _) -> + false. + +do_y_catch_2(_) -> {a,b,c}. + + +%% The identity function. +id(I) -> I. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 626f89ba7a..27979647c6 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -96,9 +96,16 @@ do_beam_file(F) -> compiler_bug(Config) when is_list(Config) -> %% Check that the compiler returns an error if we try to %% assemble one of the bad '.S' files. - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, "stack"), - ?line error = compile:file(File, [asm,report_errors,binary,time]), + Data = ?config(data_dir, Config), + File = filename:join(Data, "compiler_bug"), + error = compile:file(File, [from_asm,report_errors,time]), + + %% Make sure that the error was reported by + %% the beam_validator module. + {error, + [{"compiler_bug", + [{beam_validator,_}]}], + []} = compile:file(File, [from_asm,return_errors,time]), ok. %% The following code is stupid but it should compile. diff --git a/lib/compiler/test/beam_validator_SUITE_data/compiler_bug.S b/lib/compiler/test/beam_validator_SUITE_data/compiler_bug.S new file mode 100644 index 0000000000..ba27bf5c47 --- /dev/null +++ b/lib/compiler/test/beam_validator_SUITE_data/compiler_bug.S @@ -0,0 +1,38 @@ +{module, compiler_bug}. %% version = 0 + +{exports, [{module_info,0},{module_info,1},{sum,2}]}. + +{attributes, []}. + +{labels, 7}. + + +{function, sum, 2, 2}. + {label,1}. + {line,[{location,"compiler_bug.erl",4}]}. + {func_info,{atom,compiler_bug},{atom,sum},2}. + {label,2}. + {line,[{location,"compiler_bug.erl",5}]}. + {gc_bif,'+',{f,0},2,[{y,0},{y,1}],{x,0}}. + return. + + +{function, module_info, 0, 4}. + {label,3}. + {line,[]}. + {func_info,{atom,compiler_bug},{atom,module_info},0}. + {label,4}. + {move,{atom,compiler_bug},{x,0}}. + {line,[]}. + {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. + + +{function, module_info, 1, 6}. + {label,5}. + {line,[]}. + {func_info,{atom,compiler_bug},{atom,module_info},1}. + {label,6}. + {move,{x,0},{x,1}}. + {move,{atom,compiler_bug},{x,0}}. + {line,[]}. + {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 2d3fa7353a..e1710988d8 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -34,7 +34,7 @@ otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1, match_string/1,zero_width/1,bad_size/1,haystack/1, cover_beam_bool/1,matched_out_size/1,follow_fail_branch/1, - no_partition/1,calling_a_binary/1]). + no_partition/1,calling_a_binary/1,binary_in_map/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -59,7 +59,7 @@ groups() -> matching_and_andalso,otp_7188,otp_7233,otp_7240, otp_7498,match_string,zero_width,bad_size,haystack, cover_beam_bool,matched_out_size,follow_fail_branch, - no_partition,calling_a_binary]}]. + no_partition,calling_a_binary,binary_in_map]}]. init_per_suite(Config) -> @@ -1205,6 +1205,26 @@ call_binary(<<>>, Acc) -> call_binary(<<H,T/bits>>, Acc) -> T(<<Acc/binary,H>>). +binary_in_map(Config) when is_list(Config) -> + ok = match_binary_in_map(#{key => <<42:8>>}), + {'EXIT',{{badmatch,#{key := 1}},_}} = + (catch match_binary_in_map(#{key => 1})), + {'EXIT',{{badmatch,#{key := <<1023:16>>}},_}} = + (catch match_binary_in_map(#{key => <<1023:16>>})), + {'EXIT',{{badmatch,#{key := <<1:8>>}},_}} = + (catch match_binary_in_map(#{key => <<1:8>>})), + {'EXIT',{{badmatch,not_a_map},_}} = + (catch match_binary_in_map(not_a_map)), + ok. + +match_binary_in_map(Map) -> + case 8 of + N -> + #{key := <<42:N>>} = Map, + ok + end. + + check(F, R) -> R = F(). diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 128291dc67..0ff03c4295 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -30,7 +30,7 @@ other_output/1, encrypted_abstr/1, bad_record_use1/1, bad_record_use2/1, strict_record/1, missing_testheap/1, cover/1, env/1, core/1, asm/1, - sys_pre_attributes/1]). + sys_pre_attributes/1, dialyzer/1]). -export([init/3]). @@ -47,7 +47,7 @@ all() -> other_output, encrypted_abstr, {group, bad_record_use}, strict_record, missing_testheap, cover, env, core, asm, - sys_pre_attributes]. + sys_pre_attributes, dialyzer]. groups() -> [{bad_record_use, [], @@ -854,6 +854,20 @@ sys_pre_attributes(Config) -> [report,verbose]), ok. +%% Test the dialyzer option to cover more code. +dialyzer(Config) -> + Priv = ?config(priv_dir, Config), + file:set_cwd(?config(data_dir, Config)), + Opts = [{outdir,Priv},report_errors], + M = dialyzer_test, + {ok,M} = c:c(M, [dialyzer|Opts]), + [{a,b,c}] = M:M(), + + %% Cover huge line numbers without the 'dialyzer' option. + {ok,M} = c:c(M, Opts), + [{a,b,c}] = M:M(), + ok. + %%% %%% Utilities. %%% diff --git a/lib/compiler/test/compile_SUITE_data/dialyzer_test.erl b/lib/compiler/test/compile_SUITE_data/dialyzer_test.erl new file mode 100644 index 0000000000..ed65ff9c43 --- /dev/null +++ b/lib/compiler/test/compile_SUITE_data/dialyzer_test.erl @@ -0,0 +1,39 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(dialyzer_test). +-export([?MODULE/0,turtle/0,test/1,huge/1]). + +-record(turtle, {a,b,c}). +-record(tortoise, {a,b,c}). + +?MODULE() -> + [{a,b,c}]. + +turtle() -> + #turtle{a=1,b=2,c=3}. + +test(T) -> + {T#tortoise.a,T#tortoise.b}. + +-file("dialyzer_test", 100000000). + +huge(X) -> + #turtle{a=42,b=100,c=511}, + X#tortoise.a. diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl index afc04fd440..fb8da37f4f 100644 --- a/lib/compiler/test/float_SUITE.erl +++ b/lib/compiler/test/float_SUITE.erl @@ -118,6 +118,7 @@ math_functions(Config) when is_list(Config) -> ?line 0.0 = math:sinh(0), ?line 1.0 = math:cosh(0), ?line 0.0 = math:tanh(0), + 1.0 = math:log2(2), ?line 1.0 = math:log10(10), ?line -1.0 = math:cos(math:pi()), ?line 1.0 = math:exp(0), @@ -136,6 +137,7 @@ math_functions(Config) when is_list(Config) -> ?line 0.0 = math:sinh(id(0)), ?line 1.0 = math:cosh(id(0)), ?line 0.0 = math:tanh(id(0)), + 1.0 = math:log2(id(2)), ?line 1.0 = math:log10(id(10)), ?line 1.0 = math:exp(id(0)), ?line 0.0 = math:log(id(1)), diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 689c65f537..882e2c3f8b 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -331,7 +331,15 @@ complex_semicolon(Config) when is_list(Config) -> ?line ok = csemi6({a,b}, 0), ?line ok = csemi6({}, 3), ?line ok = csemi6({a,b,c}, 3), - + + %% 7 + error = csemi7(#{a=>1}, 1, 0), + error = csemi7(<<>>, 1, 0), + ok = csemi7(#{a=>1}, 3, 0), + ok = csemi7(#{a=>1}, 0, 3), + ok = csemi7(#{a=>1}, 3, 3), + ok = csemi7(#{a=>1, b=>3}, 0, 0), + ok. csemi1(Type, Val) when is_list(Val), Type == float; @@ -443,6 +451,9 @@ csemi5(_, _) -> error. csemi6(A, B) when hd([tuple_size(A)]) > 1; abs(B) > 2 -> ok; csemi6(_, _) -> error. +csemi7(A, B, C) when A#{a:=B} > #{a=>1}; abs(C) > 2 -> ok; +csemi7(_, _, _) -> error. + comma(Config) when is_list(Config) -> %% ',' combinations of literal true/false. @@ -1782,6 +1793,24 @@ bad_constants(Config) when is_list(Config) -> bad_guards(Config) when is_list(Config) -> if erlang:float(self()); true -> ok end, + + fc(catch bad_guards_1(1, [])), + fc(catch bad_guards_1(1, [2])), + fc(catch bad_guards_1(atom, [2])), + + fc(catch bad_guards_2(#{a=>0,b=>0}, [])), + fc(catch bad_guards_2(#{a=>0,b=>0}, [x])), + fc(catch bad_guards_2(not_a_map, [x])), + fc(catch bad_guards_2(42, [x])), + ok. + +%% beam_bool used to produce GC BIF instructions whose +%% Live operands included uninitialized registers. + +bad_guards_1(X, [_]) when {{X}}, -X -> + ok. + +bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) -> ok. %% Call this function to turn off constant propagation. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 75efce9d7b..dbac61765b 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -61,7 +61,9 @@ suite() -> []. -all() -> [ +all() -> + test_lib:recompile(?MODULE), + [ %% literals t_build_and_match_literals, t_update_literals, t_match_and_update_literals, diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index ae7d764535..e5aaf49d6f 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -22,7 +22,7 @@ init_per_group/2,end_per_group/2, pmatch/1,mixed/1,aliases/1,match_in_call/1, untuplify/1,shortcut_boolean/1,letify_guard/1, - selectify/1,underscore/1,coverage/1]). + selectify/1,underscore/1,match_map/1,coverage/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,7 +35,8 @@ all() -> groups() -> [{p,test_lib:parallel(), [pmatch,mixed,aliases,match_in_call,untuplify, - shortcut_boolean,letify_guard,selectify,underscore,coverage]}]. + shortcut_boolean,letify_guard,selectify, + underscore,match_map,coverage]}]. init_per_suite(Config) -> @@ -400,6 +401,17 @@ underscore(Config) when is_list(Config) -> _ = is_list(Config), ok. +-record(s, {map,t}). + +match_map(Config) when is_list(Config) -> + Map = #{key=>{x,y},ignore=>anything}, + #s{map=Map,t={x,y}} = do_match_map(#s{map=Map}), + ok. + +do_match_map(#s{map=#{key:=Val}}=S) -> + %% Would crash with a 'badarg' exception. + S#s{t=Val}. + coverage(Config) when is_list(Config) -> %% Cover beam_dead. ok = coverage_1(x, a), diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 00a6e900d4..fb82bf6101 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -187,12 +187,13 @@ ref_opt(Config) when is_list(Config) -> end. ref_opt_1(Config) -> - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), Sources = filelib:wildcard(filename:join([DataDir,"ref_opt","*.{erl,S}"])), - ?line test_lib:p_run(fun(Src) -> - do_ref_opt(Src, PrivDir) - end, Sources), + test_lib:p_run(fun(Src) -> + do_ref_opt(Src, PrivDir) + end, Sources), + cover_recv_instructions(), ok. do_ref_opt(Source, PrivDir) -> @@ -202,9 +203,9 @@ do_ref_opt(Source, PrivDir) -> {outdir,PrivDir}] ++ [from_asm || Ext =:= ".S" ]), Base = filename:rootname(filename:basename(Source), Ext), - code:purge(list_to_atom(Base)), - BeamFile = filename:join(PrivDir, Base), - code:load_abs(BeamFile), + code:purge(list_to_atom(Base)), + BeamFile = filename:join(PrivDir, Base), + code:load_abs(BeamFile), ok = Mod:Mod(), {beam_file,Mod,_,_,_,Code} = beam_disasm:file(BeamFile), case Base of @@ -232,6 +233,27 @@ collect_recv_opt_instrs(Code) -> end] || {function,_,_,_,Is} <- Code], lists:append(L). +cover_recv_instructions() -> + %% We want to cover the handling of recv_mark and recv_set in beam_utils. + %% Since those instructions are introduced in a late optimization pass, + %% beam_utils:live_opt() will not see them unless the compilation is + %% started from a .S file. The compile_SUITE:asm/1 test case will + %% compile all test suite files to .S and then run them through the + %% compiler again. + %% + %% Here will we will ensure that this modules contains recv_mark + %% and recv_set instructions. + Pid = spawn_link(fun() -> + receive {Parent,Ref} -> + Parent ! Ref + end + end), + Ref = make_ref(), + Pid ! {self(),Ref}, + receive + Ref -> ok + end. + export(Config) when is_list(Config) -> Ref = make_ref(), ?line self() ! {result,Ref,42}, diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index e482b1e6f8..b52c1edebf 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -139,7 +139,11 @@ <tag><c><![CDATA[-Wwarn]]></c></tag> <item>A family of options which selectively turn on/off warnings (for help on the names of warnings use - <c><![CDATA[dialyzer -Whelp]]></c>).</item> + <c><![CDATA[dialyzer -Whelp]]></c>). + Note that the options can also be given in the file with a + <c>-dialyzer()</c> attribute. See <seealso + marker="#suppression">Requesting or Suppressing Warnings in + Source Files</seealso> below for details.</item> <tag><c><![CDATA[--shell]]></c></tag> <item>Do not disable the Erlang shell while running the GUI.</item> <tag><c><![CDATA[--version]]></c> (or <c><![CDATA[-v]]></c>)</tag> @@ -269,6 +273,71 @@ given from the command line, so please refer to the sections above for a description of these.</p> </section> + + <section> + <marker id="suppression"></marker> + <title>Requesting or Suppressing Warnings in Source Files</title> + <p> + The <c>-dialyzer()</c> attribute can be used for turning off + warnings in a module by specifying functions or warning options. + For example, to turn off all warnings for the function + <c>f/0</c>, include the following line: + </p> +<code type="none"> +-dialyzer({nowarn_function, f/0}). +</code> + <p>To turn off warnings for improper lists, add the following line + to the source file: + </p> +<code type="none"> +-dialyzer(no_improper_lists). +</code> + <p>The <c>-dialyzer()</c> attribute is allowed after function + declarations. Lists of warning options or functions are allowed: + </p> +<code type="none"> +-dialyzer([{nowarn_function, [f/0]}, no_improper_lists]). +</code> + <p> + Warning options can be restricted to functions: + </p> +<code type="none"> +-dialyzer({no_improper_lists, g/0}). +</code> +<code type="none"> +-dialyzer({[no_return, no_match], [g/0, h/0]}). +</code> + <p> + For help on the warning options use <c>dialyzer -Whelp</c>. The + options are also enumerated <seealso + marker="#gui/1">below</seealso> (<c>WarnOpts</c>). + </p> + <note> + <p> + The <c>-dialyzer()</c> attribute is not checked by the Erlang + Compiler, but by the Dialyzer itself. + </p> + </note> + <note> + <p> + The warning option <c>-Wrace_conditions</c> has no effect when + set in source files. + </p> + </note> + <p> + The <c>-dialyzer()</c> attribute can also be used for turning on + warnings. For instance, if a module has been fixed regarding + unmatched returns, adding the line + </p> +<code type="none"> +-dialyzer(unmatched_returns). +</code> + <p> + can help in assuring that no new unmatched return warnings are + introduced. + </p> + </section> + <funcs> <func> <name>gui() -> ok | {error, Msg}</name> @@ -283,7 +352,7 @@ OptList :: [Option] Option :: {files, [Filename :: string()]} | {files_rec, [DirName :: string()]} - | {defines, [{Macro: atom(), Value : term()}]} + | {defines, [{Macro :: atom(), Value :: term()}]} | {from, src_code | byte_code} %% Defaults to byte_code | {init_plt, FileName :: string()} %% If changed from default | {plts, [FileName :: string()]} %% If changed from default diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl index cec94a49fd..c9e7da9ef0 100644 --- a/lib/dialyzer/src/dialyzer.erl +++ b/lib/dialyzer/src/dialyzer.erl @@ -282,15 +282,17 @@ cl_check_log(none) -> cl_check_log(Output) -> io:format(" Check output file `~s' for details\n", [Output]). --spec format_warning(dial_warning()) -> string(). +-spec format_warning(raw_warning()) -> string(). format_warning(W) -> format_warning(W, basename). --spec format_warning(dial_warning(), fopt()) -> string(). +-spec format_warning(raw_warning() | dial_warning(), fopt()) -> string(). +format_warning({Tag, {File, Line, _MFA}, Msg}, FOpt) -> + format_warning({Tag, {File, Line}, Msg}, FOpt); format_warning({_Tag, {File, Line}, Msg}, FOpt) when is_list(File), - is_integer(Line) -> + is_integer(Line) -> F = case FOpt of fullpath -> File; basename -> filename:basename(File) diff --git a/lib/dialyzer/src/dialyzer.hrl b/lib/dialyzer/src/dialyzer.hrl index 9a25f86512..90addc35a8 100644 --- a/lib/dialyzer/src/dialyzer.hrl +++ b/lib/dialyzer/src/dialyzer.hrl @@ -84,6 +84,15 @@ -type dial_warning() :: {dial_warn_tag(), file_line(), {atom(), [term()]}}. %% +%% This is the representation of each warning before suppressions have +%% been applied +%% +-type m_or_mfa() :: module() % warnings not associated with any function + | mfa(). +-type warning_info() :: {file:filename(), non_neg_integer(), m_or_mfa()}. +-type raw_warning() :: {dial_warn_tag(), warning_info(), {atom(), [term()]}}. + +%% %% This is the representation of dialyzer's internal errors %% -type dial_error() :: any(). %% XXX: underspecified @@ -103,6 +112,7 @@ -type fopt() :: 'basename' | 'fullpath'. -type format() :: 'formatted' | 'raw'. -type label() :: non_neg_integer(). +-type dial_warn_tags():: ordsets:ordset(dial_warn_tag()). -type rep_mode() :: 'quiet' | 'normal' | 'verbose'. -type start_from() :: 'byte_code' | 'src_code'. -type mfa_or_funlbl() :: label() | mfa(). @@ -138,7 +148,7 @@ init_plts = [] :: [file:filename()], include_dirs = [] :: [file:filename()], output_plt = none :: 'none' | file:filename(), - legal_warnings = ordsets:new() :: ordsets:ordset(dial_warn_tag()), + legal_warnings = ordsets:new() :: dial_warn_tags(), report_mode = normal :: rep_mode(), erlang_mode = false :: boolean(), use_contracts = true :: boolean(), diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index af1c2b7e3a..5ff7ad9c6f 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -39,8 +39,6 @@ one_file_result/0, compile_result/0]). --export_type([no_warn_unused/0]). - -include("dialyzer.hrl"). -record(analysis_state, @@ -50,8 +48,9 @@ defines = [] :: [dial_define()], doc_plt :: dialyzer_plt:plt(), include_dirs = [] :: [file:filename()], - no_warn_unused :: no_warn_unused(), parent :: pid(), + legal_warnings :: % command line options + [dial_warn_tag()], plt :: dialyzer_plt:plt(), start_from = byte_code :: start_from(), use_contracts = true :: boolean(), @@ -59,9 +58,10 @@ solvers :: [solver()] }). --record(server_state, {parent :: pid(), legal_warnings :: [dial_warn_tag()]}). - --type no_warn_unused() :: sets:set(mfa()). +-record(server_state, + { + parent :: pid() + }). %%-------------------------------------------------------------------- %% Main @@ -75,24 +75,24 @@ start(Parent, LegalWarnings, Analysis) -> Analysis0 = Analysis#analysis{race_detection = RacesOn, timing_server = TimingServer}, Analysis1 = expand_files(Analysis0), - Analysis2 = run_analysis(Analysis1), - State = #server_state{parent = Parent, legal_warnings = LegalWarnings}, + Analysis2 = run_analysis(Analysis1, LegalWarnings), + State = #server_state{parent = Parent}, loop(State, Analysis2, none), dialyzer_timing:stop(TimingServer). -run_analysis(Analysis) -> +run_analysis(Analysis, LegalWarnings) -> Self = self(), - Fun = fun() -> analysis_start(Self, Analysis) end, + Fun = fun() -> analysis_start(Self, Analysis, LegalWarnings) end, Analysis#analysis{analysis_pid = spawn_link(Fun)}. -loop(#server_state{parent = Parent, legal_warnings = LegalWarnings} = State, +loop(#server_state{parent = Parent} = State, #analysis{analysis_pid = AnalPid} = Analysis, ExtCalls) -> receive {AnalPid, log, LogMsg} -> send_log(Parent, LogMsg), loop(State, Analysis, ExtCalls); {AnalPid, warnings, Warnings} -> - case filter_warnings(LegalWarnings, Warnings) of + case Warnings of [] -> ok; SendWarnings -> send_warnings(Parent, SendWarnings) @@ -129,7 +129,7 @@ loop(#server_state{parent = Parent, legal_warnings = LegalWarnings} = State, %% The Analysis %%-------------------------------------------------------------------- -analysis_start(Parent, Analysis) -> +analysis_start(Parent, Analysis, LegalWarnings) -> CServer = dialyzer_codeserver:new(), Plt = Analysis#analysis.plt, State = #analysis_state{codeserver = CServer, @@ -139,13 +139,14 @@ analysis_start(Parent, Analysis) -> include_dirs = Analysis#analysis.include_dirs, plt = Plt, parent = Parent, + legal_warnings = LegalWarnings, start_from = Analysis#analysis.start_from, use_contracts = Analysis#analysis.use_contracts, timing_server = Analysis#analysis.timing_server, solvers = Analysis#analysis.solvers }, Files = ordsets:from_list(Analysis#analysis.files), - {Callgraph, NoWarn, TmpCServer0} = compile_and_store(Files, State), + {Callgraph, TmpCServer0} = compile_and_store(Files, State), %% Remote type postprocessing NewCServer = try @@ -177,7 +178,6 @@ analysis_start(Parent, Analysis) -> State0 = State#analysis_state{plt = NewPlt1}, dump_callgraph(Callgraph, State0, Analysis), State1 = State0#analysis_state{codeserver = NewCServer}, - State2 = State1#analysis_state{no_warn_unused = NoWarn}, %% Remove all old versions of the files being analyzed AllNodes = dialyzer_callgraph:all_nodes(Callgraph), Plt1 = dialyzer_plt:delete_list(NewPlt1, AllNodes), @@ -187,14 +187,14 @@ analysis_start(Parent, Analysis) -> true -> dialyzer_callgraph:put_race_detection(true, Callgraph); false -> Callgraph end, - State3 = analyze_callgraph(NewCallgraph, State2#analysis_state{plt = Plt1}), + State2 = analyze_callgraph(NewCallgraph, State1#analysis_state{plt = Plt1}), dialyzer_callgraph:dispose_race_server(NewCallgraph), rcv_and_send_ext_types(Parent), NonExports = sets:subtract(sets:from_list(AllNodes), Exports), NonExportsList = sets:to_list(NonExports), - Plt2 = dialyzer_plt:delete_list(State3#analysis_state.plt, NonExportsList), - send_codeserver_plt(Parent, CServer, State3#analysis_state.plt), - send_analysis_done(Parent, Plt2, State3#analysis_state.doc_plt). + Plt2 = dialyzer_plt:delete_list(State2#analysis_state.plt, NonExportsList), + send_codeserver_plt(Parent, CServer, State2#analysis_state.plt), + send_analysis_done(Parent, Plt2, State2#analysis_state.doc_plt). analyze_callgraph(Callgraph, #analysis_state{codeserver = Codeserver, doc_plt = DocPlt, @@ -210,11 +210,11 @@ analyze_callgraph(Callgraph, #analysis_state{codeserver = Codeserver, TimingServer, Solvers, Parent), {NewPlt0, DocPlt}; succ_typings -> - NoWarn = State#analysis_state.no_warn_unused, {Warnings, NewPlt0, NewDocPlt0} = dialyzer_succ_typings:get_warnings(Callgraph, Plt, DocPlt, Codeserver, - NoWarn, TimingServer, Solvers, Parent), - send_warnings(State#analysis_state.parent, Warnings), + TimingServer, Solvers, Parent), + Warnings1 = filter_warnings(Warnings, Codeserver), + send_warnings(State#analysis_state.parent, Warnings1), {NewPlt0, NewDocPlt0} end, dialyzer_callgraph:delete(Callgraph), @@ -230,19 +230,22 @@ analyze_callgraph(Callgraph, #analysis_state{codeserver = Codeserver, defines = [] :: [dial_define()], include_dirs = [] :: [file:filename()], start_from = byte_code :: start_from(), - use_contracts = true :: boolean() + use_contracts = true :: boolean(), + legal_warnings :: [dial_warn_tag()] }). make_compile_init(#analysis_state{codeserver = Codeserver, defines = Defs, include_dirs = Dirs, use_contracts = UseContracts, + legal_warnings = LegalWarnings, start_from = StartFrom}, Callgraph) -> #compile_init{callgraph = Callgraph, codeserver = Codeserver, defines = [{d, Macro, Val} || {Macro, Val} <- Defs], include_dirs = [{i, D} || D <- Dirs], use_contracts = UseContracts, + legal_warnings = LegalWarnings, start_from = StartFrom}. compile_and_store(Files, #analysis_state{codeserver = CServer, @@ -252,7 +255,7 @@ compile_and_store(Files, #analysis_state{codeserver = CServer, {T1, _} = statistics(wall_clock), Callgraph = dialyzer_callgraph:new(), CompileInit = make_compile_init(State, Callgraph), - {{Failed, NoWarn, Modules}, NextLabel} = + {{Failed, Modules}, NextLabel} = ?timing(Timing, "compile", _C1, dialyzer_coordinator:parallel_job(compile, Files, CompileInit, Timing)), @@ -281,34 +284,34 @@ compile_and_store(Files, #analysis_state{codeserver = CServer, {T3, _} = statistics(wall_clock), Msg2 = io_lib:format("done in ~.2f secs\n", [(T3-T2)/1000]), send_log(Parent, Msg2), - {Callgraph, sets:from_list(NoWarn), CServer2}. + {Callgraph, CServer2}. -type compile_init_data() :: #compile_init{}. -type error_reason() :: string(). --type compile_result() :: {[{file:filename(), error_reason()}], [mfa()], +-type compile_result() :: {[{file:filename(), error_reason()}], [module()]}. %%opaque -type one_file_result() :: {error, error_reason()} | {ok, [dialyzer_callgraph:callgraph_edge()], - [mfa_or_funlbl()], [mfa()], module()}. %%opaque --type compile_mid_data() :: {module(), cerl:cerl(), [mfa()], + [mfa_or_funlbl()], module()}. %%opaque +-type compile_mid_data() :: {module(), cerl:cerl(), dialyzer_callgraph:callgraph(), dialyzer_codeserver:codeserver()}. -spec compile_init_result() -> compile_result(). -compile_init_result() -> {[], [], []}. +compile_init_result() -> {[], []}. -spec add_to_result(file:filename(), one_file_result(), compile_result(), compile_init_data()) -> compile_result(). -add_to_result(File, NewData, {Failed, NoWarn, Mods}, InitData) -> +add_to_result(File, NewData, {Failed, Mods}, InitData) -> case NewData of {error, Reason} -> - {[{File, Reason}|Failed], NoWarn, Mods}; - {ok, V, E, NewNoWarn, Mod} -> + {[{File, Reason}|Failed], Mods}; + {ok, V, E, Mod} -> Callgraph = InitData#compile_init.callgraph, dialyzer_callgraph:add_edges(E, V, Callgraph), - {Failed, NewNoWarn ++ NoWarn, [Mod|Mods]} + {Failed, [Mod|Mods]} end. -spec start_compilation(file:filename(), compile_init_data()) -> @@ -318,12 +321,14 @@ start_compilation(File, #compile_init{callgraph = Callgraph, codeserver = Codeserver, defines = Defines, include_dirs = IncludeD, use_contracts = UseContracts, + legal_warnings = LegalWarnings, start_from = StartFrom}) -> case StartFrom of src_code -> - compile_src(File, IncludeD, Defines, Callgraph, Codeserver, UseContracts); + compile_src(File, IncludeD, Defines, Callgraph, Codeserver, + UseContracts, LegalWarnings); byte_code -> - compile_byte(File, Callgraph, Codeserver, UseContracts) + compile_byte(File, Callgraph, Codeserver, UseContracts, LegalWarnings) end. cleanup_callgraph(#analysis_state{plt = InitPlt, parent = Parent, @@ -357,88 +362,86 @@ cleanup_callgraph(#analysis_state{plt = InitPlt, parent = Parent, end, Callgraph1. -compile_src(File, Includes, Defines, Callgraph, CServer, UseContracts) -> +compile_src(File, Includes, Defines, Callgraph, CServer, UseContracts, + LegalWarnings) -> DefaultIncludes = default_includes(filename:dirname(File)), SrcCompOpts = dialyzer_utils:src_compiler_opts(), CompOpts = SrcCompOpts ++ Includes ++ Defines ++ DefaultIncludes, case dialyzer_utils:get_abstract_code_from_src(File, CompOpts) of {error, _Msg} = Error -> Error; {ok, AbstrCode} -> - compile_common(File, AbstrCode, CompOpts, Callgraph, CServer, UseContracts) + compile_common(File, AbstrCode, CompOpts, Callgraph, CServer, + UseContracts, LegalWarnings) end. -compile_byte(File, Callgraph, CServer, UseContracts) -> +compile_byte(File, Callgraph, CServer, UseContracts, LegalWarnings) -> case dialyzer_utils:get_abstract_code_from_beam(File) of error -> {error, " Could not get abstract code for: " ++ File ++ "\n" ++ " Recompile with +debug_info or analyze starting from source code"}; {ok, AbstrCode} -> - compile_byte(File, AbstrCode, Callgraph, CServer, UseContracts) + compile_byte(File, AbstrCode, Callgraph, CServer, UseContracts, + LegalWarnings) end. -compile_byte(File, AbstrCode, Callgraph, CServer, UseContracts) -> +compile_byte(File, AbstrCode, Callgraph, CServer, UseContracts, + LegalWarnings) -> case dialyzer_utils:get_compile_options_from_beam(File) of error -> {error, " Could not get compile options for: " ++ File ++ "\n" ++ " Recompile or analyze starting from source code"}; {ok, CompOpts} -> - compile_common(File, AbstrCode, CompOpts, Callgraph, CServer, UseContracts) + compile_common(File, AbstrCode, CompOpts, Callgraph, CServer, + UseContracts, LegalWarnings) end. -compile_common(File, AbstrCode, CompOpts, Callgraph, CServer, UseContracts) -> +compile_common(File, AbstrCode, CompOpts, Callgraph, CServer, + UseContracts, LegalWarnings) -> case dialyzer_utils:get_core_from_abstract_code(AbstrCode, CompOpts) of error -> {error, " Could not get core Erlang code for: " ++ File}; {ok, Core} -> Mod = cerl:concrete(cerl:module_name(Core)), - NoWarn = abs_get_nowarn(AbstrCode, Mod), case dialyzer_utils:get_record_and_type_info(AbstrCode) of {error, _} = Error -> Error; {ok, RecInfo} -> CServer1 = dialyzer_codeserver:store_temp_records(Mod, RecInfo, CServer), + MetaFunInfo = + dialyzer_utils:get_fun_meta_info(Mod, AbstrCode, LegalWarnings), + CServer2 = + dialyzer_codeserver:insert_fun_meta_info(MetaFunInfo, CServer1), case UseContracts of true -> case dialyzer_utils:get_spec_info(Mod, AbstrCode, RecInfo) of {error, _} = Error -> Error; {ok, SpecInfo, CallbackInfo} -> - CServer2 = + CServer3 = dialyzer_codeserver:store_temp_contracts(Mod, SpecInfo, CallbackInfo, - CServer1), - store_core(Mod, Core, NoWarn, Callgraph, CServer2) + CServer2), + store_core(Mod, Core, Callgraph, CServer3) end; false -> - store_core(Mod, Core, NoWarn, Callgraph, CServer1) + store_core(Mod, Core, Callgraph, CServer2) end end end. -store_core(Mod, Core, NoWarn, Callgraph, CServer) -> +store_core(Mod, Core, Callgraph, CServer) -> Exp = get_exports_from_core(Core), ExpTypes = get_exported_types_from_core(Core), CServer = dialyzer_codeserver:insert_exports(Exp, CServer), CServer = dialyzer_codeserver:insert_temp_exported_types(ExpTypes, CServer), CoreTree = cerl:from_records(Core), - {ok, cerl_trees:size(CoreTree), {Mod, CoreTree, NoWarn, Callgraph, CServer}}. + CoreSize = cerl_trees:size(CoreTree), + {ok, CoreSize, {Mod, CoreTree, Callgraph, CServer}}. -spec continue_compilation(integer(), compile_mid_data()) -> one_file_result(). -continue_compilation(NextLabel, {Mod, CoreTree, NoWarn, Callgraph, CServer}) -> +continue_compilation(NextLabel, {Mod, CoreTree, Callgraph, CServer}) -> {LabeledTree, _NewNextLabel} = cerl_trees:label(CoreTree, NextLabel), LabeledCore = cerl:to_records(LabeledTree), - store_code_and_build_callgraph(Mod, LabeledCore, Callgraph, NoWarn, CServer). - -abs_get_nowarn(Abs, M) -> - Opts = lists:flatten([C || {attribute, _, compile, C} <- Abs]), - Warn = erl_lint:bool_option(warn_unused_function, nowarn_unused_function, - true, Opts), - case Warn of - false -> - [{M, F, A} || {function, _, F, A, _} <- Abs]; % all functions - true -> - [{M, F, A} || {nowarn_unused_function, FAs} <- Opts, - {F, A} <- lists:flatten([FAs])] - end. + store_code_and_build_callgraph(Mod, LabeledCore, Callgraph, CServer). get_exported_types_from_core(Core) -> Attrs = cerl:module_attrs(Core), @@ -456,11 +459,11 @@ get_exports_from_core(Core) -> M = cerl:atom_val(cerl:module_name(Tree)), [{M, F, A} || {F, A} <- Exports2]. -store_code_and_build_callgraph(Mod, Core, Callgraph, NoWarn, CServer) -> +store_code_and_build_callgraph(Mod, Core, Callgraph, CServer) -> CoreTree = cerl:from_records(Core), {Vertices, Edges} = dialyzer_callgraph:scan_core_tree(CoreTree, Callgraph), CServer = dialyzer_codeserver:insert(Mod, CoreTree, CServer), - {ok, Vertices, Edges, NoWarn, Mod}. + {ok, Vertices, Edges, Mod}. %%-------------------------------------------------------------------- %% Utilities @@ -548,10 +551,19 @@ send_warnings(Parent, Warnings) -> Parent ! {self(), warnings, Warnings}, ok. -filter_warnings(LegalWarnings, Warnings) -> - [TIW || {Tag, _Id, _Warning} = TIW <- Warnings, - ordsets:is_element(Tag, LegalWarnings)]. +filter_warnings(Warnings, Codeserver) -> + [TWW || {Tag, WarningInfo, _Warning} = TWW <- Warnings, + is_ok_fun(WarningInfo, Codeserver), + is_ok_tag(Tag, WarningInfo, Codeserver)]. + +is_ok_fun({_F, _L, Module}, _Codeserver) when is_atom(Module) -> + true; +is_ok_fun({_Filename, _Line, {_M, _F, _A} = MFA}, Codeserver) -> + not dialyzer_utils:is_suppressed_fun(MFA, Codeserver). +is_ok_tag(Tag, {_F, _L, MorMFA}, Codeserver) -> + not dialyzer_utils:is_suppressed_tag(MorMFA, Tag, Codeserver). + send_analysis_done(Parent, Plt, DocPlt) -> Parent ! {self(), done, Plt, DocPlt}, ok. @@ -573,7 +585,8 @@ send_codeserver_plt(Parent, CServer, Plt ) -> ok. send_bad_calls(Parent, BadCalls, CodeServer) -> - send_warnings(Parent, format_bad_calls(BadCalls, CodeServer, [])). + FormatedBadCalls = format_bad_calls(BadCalls, CodeServer, []), + send_warnings(Parent, FormatedBadCalls). send_mod_deps(Parent, ModuleDeps) -> Parent ! {self(), mod_deps, ModuleDeps}, @@ -585,8 +598,9 @@ format_bad_calls([{{_, _, _}, {_, module_info, A}}|Left], CodeServer, Acc) format_bad_calls([{FromMFA, {M, F, A} = To}|Left], CodeServer, Acc) -> {_Var, FunCode} = dialyzer_codeserver:lookup_mfa_code(FromMFA, CodeServer), Msg = {call_to_missing, [M, F, A]}, - FileLine = find_call_file_and_line(FunCode, To), - NewAcc = [{?WARN_CALLGRAPH, FileLine, Msg}|Acc], + {File, Line} = find_call_file_and_line(FunCode, To), + WarningInfo = {File, Line, FromMFA}, + NewAcc = [{?WARN_CALLGRAPH, WarningInfo, Msg}|Acc], format_bad_calls(Left, CodeServer, NewAcc); format_bad_calls([], _CodeServer, Acc) -> Acc. diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl index bbedd3201e..19b63bd2c8 100644 --- a/lib/dialyzer/src/dialyzer_behaviours.erl +++ b/lib/dialyzer/src/dialyzer_behaviours.erl @@ -52,7 +52,7 @@ -spec check_callbacks(module(), [{cerl:cerl(), cerl:cerl()}], rectab(), dialyzer_plt:plt(), - dialyzer_codeserver:codeserver()) -> [dial_warning()]. + dialyzer_codeserver:codeserver()) -> [raw_warning()]. check_callbacks(Module, Attrs, Records, Plt, Codeserver) -> {Behaviours, BehLines} = get_behaviours(Attrs), @@ -65,7 +65,7 @@ check_callbacks(Module, Attrs, Records, Plt, Codeserver) -> State = #state{plt = Plt, filename = File, behlines = BehLines, codeserver = Codeserver, records = Records}, Warnings = get_warnings(Module, Behaviours, State), - [add_tag_file_line(Module, W, State) || W <- Warnings] + [add_tag_warning_info(Module, W, State) || W <- Warnings] end. %%-------------------------------------------------------------------- @@ -193,7 +193,7 @@ find_mismatching_args(Kind, [Type|Rest], [CbType|CbRest], Behaviour, Arity, Records, N+1, NewAcc) end. -add_tag_file_line(_Module, {Tag, [B|_R]} = Warn, State) +add_tag_warning_info(Module, {Tag, [B|_R]} = Warn, State) when Tag =:= callback_missing; Tag =:= callback_info_missing -> {B, Line} = lists:keyfind(B, 1, State#state.behlines), @@ -202,18 +202,18 @@ add_tag_file_line(_Module, {Tag, [B|_R]} = Warn, State) callback_missing -> ?WARN_BEHAVIOUR; callback_info_missing -> ?WARN_UNDEFINED_CALLBACK end, - {Category, {State#state.filename, Line}, Warn}; -add_tag_file_line(_Module, {Tag, [File, Line|R]}, _State) + {Category, {State#state.filename, Line, Module}, Warn}; +add_tag_warning_info(Module, {Tag, [File, Line|R]}, _State) when Tag =:= callback_spec_type_mismatch; Tag =:= callback_spec_arg_type_mismatch -> - {?WARN_BEHAVIOUR, {File, Line}, {Tag, R}}; -add_tag_file_line(Module, {_Tag, [_B, Fun, Arity|_R]} = Warn, State) -> + {?WARN_BEHAVIOUR, {File, Line, Module}, {Tag, R}}; +add_tag_warning_info(Module, {_Tag, [_B, Fun, Arity|_R]} = Warn, State) -> {_A, FunCode} = dialyzer_codeserver:lookup_mfa_code({Module, Fun, Arity}, State#state.codeserver), Anns = cerl:get_ann(FunCode), - FileLine = {get_file(Anns), get_line(Anns)}, - {?WARN_BEHAVIOUR, FileLine, Warn}. + WarningInfo = {get_file(Anns), get_line(Anns), {Module, Fun, Arity}}, + {?WARN_BEHAVIOUR, WarningInfo, Warn}. get_line([Line|_]) when is_integer(Line) -> Line; get_line([_|Tail]) -> get_line(Tail); diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 3e7d9dfa99..debb78bd0b 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -48,7 +48,7 @@ plt_info = none :: 'none' | dialyzer_plt:plt_info(), report_mode = normal :: rep_mode(), return_status= ?RET_NOTHING_SUSPICIOUS :: dial_ret(), - stored_warnings = [] :: [dial_warning()], + stored_warnings = [] :: [raw_warning()], unknown_behaviours = [] :: [dialyzer_behaviours:behaviour()] }). @@ -627,7 +627,7 @@ format_log_cache(LogCache) -> Str = lists:append(lists:reverse(LogCache)), string:join(string:tokens(Str, "\n"), "\n "). --spec store_warnings(#cl_state{}, [dial_warning()]) -> #cl_state{}. +-spec store_warnings(#cl_state{}, [raw_warning()]) -> #cl_state{}. store_warnings(#cl_state{stored_warnings = StoredWarnings} = St, Warnings) -> St#cl_state{stored_warnings = StoredWarnings ++ Warnings}. @@ -685,16 +685,22 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, unknown_behaviours(State); false -> [] end, + WarningInfo = {_Filename = "", _Line = 0, _MorMFA = ''}, UnknownWarnings = - [{?WARN_UNKNOWN, {_Filename = "", _Line = 0}, W} || W <- Unknown], + [{?WARN_UNKNOWN, WarningInfo, W} || W <- Unknown], AllWarnings = UnknownWarnings ++ process_warnings(StoredWarnings), - {RetValue, AllWarnings} + {RetValue, set_warning_id(AllWarnings)} end. unknown_functions(#cl_state{external_calls = Calls}) -> [{unknown_function, MFA} || MFA <- Calls]. +set_warning_id(Warnings) -> + lists:map(fun({Tag, {File, Line, _MorMFA}, Msg}) -> + {Tag, {File, Line}, Msg} + end, Warnings). + print_ext_calls(#cl_state{report_mode = quiet}) -> ok; print_ext_calls(#cl_state{output = Output, @@ -817,15 +823,16 @@ print_warnings(#cl_state{output = Output, formatted -> [dialyzer:format_warning(W, FOpt) || W <- PrWarnings]; raw -> - [io_lib:format("~p. \n", [W]) || W <- PrWarnings] + [io_lib:format("~p. \n", + [W]) || W <- set_warning_id(PrWarnings)] end, io:format(Output, "\n~s", [S]) end. --spec process_warnings([dial_warning()]) -> [dial_warning()]. +-spec process_warnings([raw_warning()]) -> [raw_warning()]. process_warnings(Warnings) -> - Warnings1 = lists:keysort(2, Warnings), %% Sort on file/line + Warnings1 = lists:keysort(2, Warnings), %% Sort on file/line (and m/mfa..) remove_duplicate_warnings(Warnings1, []). remove_duplicate_warnings([Duplicate, Duplicate|Left], Acc) -> diff --git a/lib/dialyzer/src/dialyzer_codeserver.erl b/lib/dialyzer/src/dialyzer_codeserver.erl index 593e71f30b..e0add00061 100644 --- a/lib/dialyzer/src/dialyzer_codeserver.erl +++ b/lib/dialyzer/src/dialyzer_codeserver.erl @@ -43,19 +43,21 @@ insert/3, insert_exports/2, insert_temp_exported_types/2, + insert_fun_meta_info/2, is_exported/2, lookup_mod_code/2, lookup_mfa_code/2, lookup_mod_records/2, lookup_mod_contracts/2, lookup_mfa_contract/2, + lookup_meta_info/2, new/0, set_next_core_label/2, set_temp_records/2, store_temp_records/3, store_temp_contracts/4]). --export_type([codeserver/0]). +-export_type([codeserver/0, fun_meta_info/0]). -include("dialyzer.hrl"). @@ -70,12 +72,19 @@ -type contracts() :: dict:dict(mfa(),dialyzer_contracts:file_contract()). -type mod_contracts() :: dict:dict(module(), contracts()). +%% A property-list of data compiled from -compile and -dialyzer attributes. +-type meta_info() :: [{{'nowarn_function' | dial_warn_tag()}, + 'mod' | 'func'}]. +-type fun_meta_info() :: [{mfa(), meta_info()} + | {module(), [dial_warn_tag()]}]. + -record(codeserver, {next_core_label = 0 :: label(), code :: dict_ets(), exported_types :: set_ets(), % set(mfa()) records :: dict_ets(), contracts :: dict_ets(), callbacks :: dict_ets(), + fun_meta_info :: dict_ets(), % {mfa(), meta_info()} exports :: 'clean' | set_ets(), % set(mfa()) temp_exported_types :: 'clean' | set_ets(), % set(mfa()) temp_records :: 'clean' | dict_ets(), @@ -129,14 +138,17 @@ new() -> CodeOptions = [compressed, public, {read_concurrency, true}], Code = ets:new(dialyzer_codeserver_code, CodeOptions), TempOptions = [public, {write_concurrency, true}], - [Exports, TempExportedTypes, TempRecords, TempContracts, TempCallbacks] = + [Exports, FunMetaInfo, TempExportedTypes, TempRecords, TempContracts, + TempCallbacks] = [ets:new(Name, TempOptions) || Name <- - [dialyzer_codeserver_exports, dialyzer_codeserver_temp_exported_types, + [dialyzer_codeserver_exports, dialyzer_codeserver_fun_meta_info, + dialyzer_codeserver_temp_exported_types, dialyzer_codeserver_temp_records, dialyzer_codeserver_temp_contracts, dialyzer_codeserver_temp_callbacks]], #codeserver{code = Code, exports = Exports, + fun_meta_info = FunMetaInfo, temp_exported_types = TempExportedTypes, temp_records = TempRecords, temp_contracts = TempContracts, @@ -184,6 +196,12 @@ insert_exports(List, #codeserver{exports = Exports} = CS) -> true = ets_set_insert_list(List, Exports), CS. +-spec insert_fun_meta_info(fun_meta_info(), codeserver()) -> codeserver(). + +insert_fun_meta_info(List, #codeserver{fun_meta_info = FunMetaInfo} = CS) -> + true = ets:insert(FunMetaInfo, List), + CS. + -spec is_exported(mfa(), codeserver()) -> boolean(). is_exported(MFA, #codeserver{exports = Exports}) -> @@ -290,6 +308,14 @@ get_file_contract(Key, ContDict) -> lookup_mfa_contract(MFA, #codeserver{contracts = ContDict}) -> ets_dict_find(MFA, ContDict). +-spec lookup_meta_info(module() | mfa(), codeserver()) -> meta_info(). + +lookup_meta_info(MorMFA, #codeserver{fun_meta_info = FunMetaInfo}) -> + case ets_dict_find(MorMFA, FunMetaInfo) of + error -> []; + {ok, PropList} -> PropList + end. + -spec get_contracts(codeserver()) -> mod_contracts(). get_contracts(#codeserver{contracts = ContDict}) -> diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index ee147ca102..39a178cb7d 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -351,7 +351,7 @@ solve_constraints(Contract, Call, Constraints) -> %% Checks the contracts for functions that are not implemented -spec contracts_without_fun(contracts(), [_], dialyzer_callgraph:callgraph()) -> - [dial_warning()]. + [raw_warning()]. contracts_without_fun(Contracts, AllFuns0, Callgraph) -> AllFuns1 = [{dialyzer_callgraph:lookup_name(Label, Callgraph), Arity} @@ -362,8 +362,9 @@ contracts_without_fun(Contracts, AllFuns0, Callgraph) -> [warn_spec_missing_fun(MFA, Contracts) || MFA <- ErrorContractMFAs]. warn_spec_missing_fun({M, F, A} = MFA, Contracts) -> - {FileLine, _Contract, _Xtra} = dict:fetch(MFA, Contracts), - {?WARN_CONTRACT_SYNTAX, FileLine, {spec_missing_fun, [M, F, A]}}. + {{File, Line}, _Contract, _Xtra} = dict:fetch(MFA, Contracts), + WarningInfo = {File, Line, MFA}, + {?WARN_CONTRACT_SYNTAX, WarningInfo, {spec_missing_fun, [M, F, A]}}. %% This treats the "when" constraints. It will be extended, we hope. insert_constraints([{subtype, Type1, Type2}|Left], Dict) -> @@ -585,7 +586,7 @@ general_domain([], AccSig) -> -spec get_invalid_contract_warnings([module()], dialyzer_codeserver:codeserver(), dialyzer_plt:plt(), - opaques_fun()) -> [dial_warning()]. + opaques_fun()) -> [raw_warning()]. get_invalid_contract_warnings(Modules, CodeServer, Plt, FindOpaques) -> get_invalid_contract_warnings_modules(Modules, CodeServer, Plt, FindOpaques, []). @@ -609,12 +610,14 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left], Sig = erl_types:t_fun(Args, Ret), {M, _F, _A} = MFA, Opaques = FindOpaques(M), + {File, Line} = FileLine, + WarningInfo = {File, Line, MFA}, NewAcc = case check_contract(Contract, Sig, Opaques) of {error, invalid_contract} -> - [invalid_contract_warning(MFA, FileLine, Sig, RecDict)|Acc]; + [invalid_contract_warning(MFA, WarningInfo, Sig, RecDict)|Acc]; {error, {overlapping_contract, []}} -> - [overlapping_contract_warning(MFA, FileLine)|Acc]; + [overlapping_contract_warning(MFA, WarningInfo)|Acc]; {error, {extra_range, ExtraRanges, STRange}} -> Warn = case t_from_forms_without_remote(Contract#contract.forms, @@ -627,12 +630,12 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left], end, case Warn of true -> - [extra_range_warning(MFA, FileLine, ExtraRanges, STRange)|Acc]; + [extra_range_warning(MFA, WarningInfo, ExtraRanges, STRange)|Acc]; false -> Acc end; {error, Msg} -> - [{?WARN_CONTRACT_SYNTAX, FileLine, Msg}|Acc]; + [{?WARN_CONTRACT_SYNTAX, WarningInfo, Msg}|Acc]; ok -> {M, F, A} = MFA, CSig0 = get_contract_signature(Contract), @@ -646,14 +649,14 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left], BifSig = erl_types:t_fun(BifArgs, BifRet), case check_contract(Contract, BifSig, Opaques) of {error, _} -> - [invalid_contract_warning(MFA, FileLine, BifSig, RecDict) + [invalid_contract_warning(MFA, WarningInfo, BifSig, RecDict) |Acc]; ok -> - picky_contract_check(CSig, BifSig, MFA, FileLine, + picky_contract_check(CSig, BifSig, MFA, WarningInfo, Contract, RecDict, Acc) end; false -> - picky_contract_check(CSig, Sig, MFA, FileLine, Contract, + picky_contract_check(CSig, Sig, MFA, WarningInfo, Contract, RecDict, Acc) end end, @@ -662,20 +665,20 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left], get_invalid_contract_warnings_funs([], _Plt, _RecDict, _FindOpaques, Acc) -> Acc. -invalid_contract_warning({M, F, A}, FileLine, SuccType, RecDict) -> +invalid_contract_warning({M, F, A}, WarningInfo, SuccType, RecDict) -> SuccTypeStr = dialyzer_utils:format_sig(SuccType, RecDict), - {?WARN_CONTRACT_TYPES, FileLine, {invalid_contract, [M, F, A, SuccTypeStr]}}. + {?WARN_CONTRACT_TYPES, WarningInfo, {invalid_contract, [M, F, A, SuccTypeStr]}}. -overlapping_contract_warning({M, F, A}, FileLine) -> - {?WARN_CONTRACT_TYPES, FileLine, {overlapping_contract, [M, F, A]}}. +overlapping_contract_warning({M, F, A}, WarningInfo) -> + {?WARN_CONTRACT_TYPES, WarningInfo, {overlapping_contract, [M, F, A]}}. -extra_range_warning({M, F, A}, FileLine, ExtraRanges, STRange) -> +extra_range_warning({M, F, A}, WarningInfo, ExtraRanges, STRange) -> ERangesStr = erl_types:t_to_string(ExtraRanges), STRangeStr = erl_types:t_to_string(STRange), - {?WARN_CONTRACT_SUPERTYPE, FileLine, + {?WARN_CONTRACT_SUPERTYPE, WarningInfo, {extra_range, [M, F, A, ERangesStr, STRangeStr]}}. -picky_contract_check(CSig0, Sig0, MFA, FileLine, Contract, RecDict, Acc) -> +picky_contract_check(CSig0, Sig0, MFA, WarningInfo, Contract, RecDict, Acc) -> CSig = erl_types:t_abstract_records(CSig0, RecDict), Sig = erl_types:t_abstract_records(Sig0, RecDict), case erl_types:t_is_equal(CSig, Sig) of @@ -685,7 +688,7 @@ picky_contract_check(CSig0, Sig0, MFA, FileLine, Contract, RecDict, Acc) -> erl_types:t_is_unit(erl_types:t_fun_range(CSig))) of true -> Acc; false -> - case extra_contract_warning(MFA, FileLine, Contract, + case extra_contract_warning(MFA, WarningInfo, Contract, CSig0, Sig0, RecDict) of no_warning -> Acc; {warning, Warning} -> [Warning|Acc] @@ -693,7 +696,7 @@ picky_contract_check(CSig0, Sig0, MFA, FileLine, Contract, RecDict, Acc) -> end end. -extra_contract_warning({M, F, A}, FileLine, Contract, CSig, Sig, RecDict) -> +extra_contract_warning({M, F, A}, WarningInfo, Contract, CSig, Sig, RecDict) -> %% We do not want to depend upon erl_types:t_to_string() possibly %% hiding the contents of opaque types. SigUnopaque = erl_types:t_unopaque(Sig), @@ -724,7 +727,7 @@ extra_contract_warning({M, F, A}, FileLine, Contract, CSig, Sig, RecDict) -> {?WARN_CONTRACT_NOT_EQUAL, {contract_diff, [M, F, A, ContractString, SigString]}} end, - {warning, {Tag, FileLine, Msg}} + {warning, {Tag, WarningInfo, Msg}} end. is_remote_types_related(Contract, CSig, Sig, RecDict) -> diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 46467a1303..ea1b09fcdd 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -28,14 +28,15 @@ -module(dialyzer_dataflow). --export([get_fun_types/4, get_warnings/5, format_args/3]). +-export([get_fun_types/5, get_warnings/5, format_args/3]). %% Data structure interfaces. -export([state__add_warning/2, state__cleanup/1, state__duplicate/1, dispose_state/1, state__get_callgraph/1, state__get_races/1, state__get_records/1, state__put_callgraph/2, - state__put_races/2, state__records_only/1]). + state__put_races/2, state__records_only/1, + state__find_function/2]). -export_type([state/0]). @@ -89,6 +90,8 @@ -type type() :: erl_types:erl_type(). -type types() :: erl_types:type_table(). +-type curr_fun() :: 'undefined' | 'top' | mfa_or_funlbl(). + -define(no_arg, no_arg). -define(TYPE_LIMIT, 3). @@ -96,17 +99,20 @@ -define(BITS, 128). -record(state, {callgraph :: dialyzer_callgraph:callgraph(), + codeserver :: dialyzer_codeserver:codeserver(), envs :: env_tab(), fun_tab :: fun_tab(), + fun_homes :: dict:dict(label(), mfa()), plt :: dialyzer_plt:plt(), opaques :: [type()], races = dialyzer_races:new() :: dialyzer_races:races(), records = dict:new() :: types(), tree_map :: dict:dict(label(), cerl:cerl()), warning_mode = false :: boolean(), - warnings = [] :: [dial_warning()], + warnings = [] :: [raw_warning()], work :: {[_], [_], sets:set()}, - module :: module() + module :: module(), + curr_fun :: curr_fun() }). -record(map, {dict = dict:new() :: type_tab(), @@ -115,7 +121,6 @@ modified_stack = [] :: [{[Key :: term()],reference()}], ref = undefined :: reference() | undefined}). --type nowarn() :: dialyzer_analysis_callgraph:no_warn_unused(). -type env_tab() :: dict:dict(label(), #map{}). -type fun_entry() :: {Args :: [type()], RetType :: type()}. -type fun_tab() :: dict:dict('top' | label(), @@ -133,22 +138,24 @@ -type fun_types() :: dict:dict(label(), type()). -spec get_warnings(cerl:c_module(), dialyzer_plt:plt(), - dialyzer_callgraph:callgraph(), types(), nowarn()) -> - {[dial_warning()], fun_types()}. - -get_warnings(Tree, Plt, Callgraph, Records, NoWarnUnused) -> - State1 = analyze_module(Tree, Plt, Callgraph, Records, true), - State2 = - state__renew_warnings(state__get_warnings(State1, NoWarnUnused), State1), + dialyzer_callgraph:callgraph(), + dialyzer_codeserver:codeserver(), + types()) -> + {[raw_warning()], fun_types()}. + +get_warnings(Tree, Plt, Callgraph, Codeserver, Records) -> + State1 = analyze_module(Tree, Plt, Callgraph, Codeserver, Records, true), + State2 = state__renew_warnings(state__get_warnings(State1), State1), State3 = state__get_race_warnings(State2), {State3#state.warnings, state__all_fun_types(State3)}. -spec get_fun_types(cerl:c_module(), dialyzer_plt:plt(), dialyzer_callgraph:callgraph(), + dialyzer_codeserver:codeserver(), types()) -> fun_types(). -get_fun_types(Tree, Plt, Callgraph, Records) -> - State = analyze_module(Tree, Plt, Callgraph, Records, false), +get_fun_types(Tree, Plt, Callgraph, Codeserver, Records) -> + State = analyze_module(Tree, Plt, Callgraph, Codeserver, Records, false), state__all_fun_types(State). %%% =========================================================================== @@ -157,11 +164,11 @@ get_fun_types(Tree, Plt, Callgraph, Records) -> %%% %%% =========================================================================== -analyze_module(Tree, Plt, Callgraph, Records, GetWarnings) -> +analyze_module(Tree, Plt, Callgraph, Codeserver, Records, GetWarnings) -> debug_pp(Tree, false), Module = cerl:atom_val(cerl:module_name(Tree)), TopFun = cerl:ann_c_fun([{label, top}], [], Tree), - State = state__new(Callgraph, TopFun, Plt, Module, Records), + State = state__new(Callgraph, Codeserver, TopFun, Plt, Module, Records), State1 = state__race_analysis(not GetWarnings, State), State2 = analyze_loop(State1), case GetWarnings of @@ -175,25 +182,26 @@ analyze_module(Tree, Plt, Callgraph, Records, GetWarnings) -> analyze_loop(State) -> case state__get_work(State) of - none -> State; - {Fun, NewState1} -> + none -> state__set_curr_fun(undefined, State); + {Fun, NewState0} -> + NewState1 = state__set_curr_fun(get_label(Fun), NewState0), {ArgTypes, IsCalled} = state__get_args_and_status(Fun, NewState1), case not IsCalled of true -> ?debug("Not handling (not called) ~w: ~s\n", - [state__lookup_name(get_label(Fun), State), + [NewState1#state.curr_fun, t_to_string(t_product(ArgTypes))]), analyze_loop(NewState1); false -> case state__fun_env(Fun, NewState1) of none -> ?debug("Not handling (no env) ~w: ~s\n", - [state__lookup_name(get_label(Fun), State), + [NewState1#state.curr_fun, t_to_string(t_product(ArgTypes))]), analyze_loop(NewState1); Map -> ?debug("Handling fun ~p: ~s\n", - [state__lookup_name(get_label(Fun), State), + [NewState1#state.curr_fun, t_to_string(state__fun_type(Fun, NewState1))]), Vars = cerl:fun_vars(Fun), Map1 = enter_type_lists(Vars, ArgTypes, Map), @@ -212,7 +220,7 @@ analyze_loop(State) -> {NewState4, _Map2, BodyType} = traverse(Body, Map1, NewState3), ?debug("Done analyzing: ~w:~s\n", - [state__lookup_name(get_label(Fun), State), + [NewState1#state.curr_fun, t_to_string(t_fun(ArgTypes, BodyType))]), NewState5 = case IsRaceAnalysisEnabled of @@ -2780,9 +2788,9 @@ filter_match_fail([]) -> %%% %%% =========================================================================== -state__new(Callgraph, Tree, Plt, Module, Records) -> +state__new(Callgraph, Codeserver, Tree, Plt, Module, Records) -> Opaques = erl_types:t_opaque_from_records(Records), - TreeMap = build_tree_map(Tree), + {TreeMap, FunHomes} = build_tree_map(Tree, Callgraph), Funs = dict:fetch_keys(TreeMap), FunTab = init_fun_tab(Funs, dict:new(), TreeMap, Callgraph, Plt), ExportedFuns = @@ -2790,7 +2798,8 @@ state__new(Callgraph, Tree, Plt, Module, Records) -> Work = init_work(ExportedFuns), Env = lists:foldl(fun(Fun, Env) -> dict:store(Fun, map__new(), Env) end, dict:new(), Funs), - #state{callgraph = Callgraph, envs = Env, fun_tab = FunTab, opaques = Opaques, + #state{callgraph = Callgraph, codeserver = Codeserver, + envs = Env, fun_tab = FunTab, fun_homes = FunHomes, opaques = Opaques, plt = Plt, races = dialyzer_races:new(), records = Records, warning_mode = false, warnings = [], work = Work, tree_map = TreeMap, module = Module}. @@ -2829,7 +2838,7 @@ state__renew_race_list(RaceList, RaceListSize, state__renew_warnings(Warnings, State) -> State#state{warnings = Warnings}. --spec state__add_warning(dial_warning(), state()) -> state(). +-spec state__add_warning(raw_warning(), state()) -> state(). state__add_warning(Warn, #state{warnings = Warnings} = State) -> State#state{warnings = [Warn|Warnings]}. @@ -2844,29 +2853,45 @@ state__add_warning(#state{warnings = Warnings, warning_mode = true} = State, Ann = cerl:get_ann(Tree), case Force of true -> - Warn = {Tag, {get_file(Ann), abs(get_line(Ann))}, Msg}, + WarningInfo = {get_file(Ann), + abs(get_line(Ann)), + State#state.curr_fun}, + Warn = {Tag, WarningInfo, Msg}, ?debug("MSG ~s\n", [dialyzer:format_warning(Warn)]), State#state{warnings = [Warn|Warnings]}; false -> case is_compiler_generated(Ann) of - true -> State; - false -> - Warn = {Tag, {get_file(Ann), get_line(Ann)}, Msg}, + true -> State; + false -> + WarningInfo = {get_file(Ann), get_line(Ann), State#state.curr_fun}, + Warn = {Tag, WarningInfo, Msg}, ?debug("MSG ~s\n", [dialyzer:format_warning(Warn)]), - State#state{warnings = [Warn|Warnings]} + State#state{warnings = [Warn|Warnings]} end end. +-spec state__set_curr_fun(curr_fun(), state()) -> state(). + +state__set_curr_fun(undefined, State) -> + State#state{curr_fun = undefined}; +state__set_curr_fun(FunLbl, State) -> + State#state{curr_fun = find_function(FunLbl, State)}. + +-spec state__find_function(mfa_or_funlbl(), state()) -> mfa_or_funlbl(). + +state__find_function(FunLbl, State) -> + find_function(FunLbl, State). + state__get_race_warnings(#state{races = Races} = State) -> {Races1, State1} = dialyzer_races:get_race_warnings(Races, State), State1#state{races = Races1}. state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab, - callgraph = Callgraph, plt = Plt} = State, - NoWarnUnused) -> + callgraph = Callgraph, plt = Plt} = State) -> FoldFun = fun({top, _}, AccState) -> AccState; ({FunLbl, Fun}, AccState) -> + AccState1 = state__set_curr_fun(FunLbl, AccState), {NotCalled, Ret} = case dict:fetch(get_label(Fun), FunTab) of {not_handled, {_Args0, Ret0}} -> {true, Ret0}; @@ -2874,17 +2899,12 @@ state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab, end, case NotCalled of true -> - {Warn, Msg} = - case dialyzer_callgraph:lookup_name(FunLbl, Callgraph) of - error -> {false, {}}; - {ok, {_M, F, A} = MFA} -> - {not sets:is_element(MFA, NoWarnUnused), - {unused_fun, [F, A]}} - end, - case Warn of - true -> state__add_warning(AccState, ?WARN_NOT_CALLED, Fun, Msg); - false -> AccState - end; + case dialyzer_callgraph:lookup_name(FunLbl, Callgraph) of + error -> AccState1; + {ok, {_M, F, A}} -> + Msg = {unused_fun, [F, A]}, + state__add_warning(AccState1, ?WARN_NOT_CALLED, Fun, Msg) + end; false -> {Name, Contract} = case dialyzer_callgraph:lookup_name(FunLbl, Callgraph) of @@ -2897,7 +2917,7 @@ state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab, %% Check if the function has a contract that allows this. Warn = case Contract of - none -> not parent_allows_this(FunLbl, State); + none -> not parent_allows_this(FunLbl, AccState1); {value, C} -> GenRet = dialyzer_contracts:get_contract_return(C), not t_is_unit(GenRet) @@ -2907,19 +2927,19 @@ state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab, case classify_returns(Fun) of no_match -> Msg = {no_return, [no_match|Name]}, - state__add_warning(AccState, ?WARN_RETURN_NO_RETURN, + state__add_warning(AccState1, ?WARN_RETURN_NO_RETURN, Fun, Msg); only_explicit -> Msg = {no_return, [only_explicit|Name]}, - state__add_warning(AccState, ?WARN_RETURN_ONLY_EXIT, + state__add_warning(AccState1, ?WARN_RETURN_ONLY_EXIT, Fun, Msg); only_normal -> Msg = {no_return, [only_normal|Name]}, - state__add_warning(AccState, ?WARN_RETURN_NO_RETURN, + state__add_warning(AccState1, ?WARN_RETURN_NO_RETURN, Fun, Msg); both -> Msg = {no_return, [both|Name]}, - state__add_warning(AccState, ?WARN_RETURN_NO_RETURN, + state__add_warning(AccState1, ?WARN_RETURN_NO_RETURN, Fun, Msg) end; false -> @@ -2970,17 +2990,31 @@ state__get_args_and_status(Tree, #state{fun_tab = FunTab}) -> {ok, {ArgTypes, _}} -> {ArgTypes, true} end. -build_tree_map(Tree) -> +build_tree_map(Tree, Callgraph) -> Fun = - fun(T, Dict) -> + fun(T, {Dict, Homes, FunLbls} = Acc) -> case cerl:is_c_fun(T) of true -> - dict:store(get_label(T), T, Dict); + FunLbl = get_label(T), + Dict1 = dict:store(FunLbl, T, Dict), + case catch dialyzer_callgraph:lookup_name(FunLbl, Callgraph) of + {ok, MFA} -> + F2 = + fun(Lbl, Dict0) -> + dict:store(Lbl, MFA, Dict0) + end, + Homes1 = lists:foldl(F2, Homes, [FunLbl|FunLbls]), + {Dict1, Homes1, []}; + _ -> + {Dict1, Homes, [FunLbl|FunLbls]} + end; false -> - Dict + Acc end end, - cerl_trees:fold(Fun, dict:new(), Tree). + Dict0 = dict:new(), + {Dict, Homes, _} = cerl_trees:fold(Fun, {Dict0, Dict0, []}, Tree), + {Dict, Homes}. init_fun_tab([top|Left], Dict, TreeMap, Callgraph, Plt) -> NewDict = dict:store(top, {[], t_none()}, Dict), @@ -3438,6 +3472,13 @@ parent_allows_this(FunLbl, #state{callgraph = Callgraph, plt = Plt} =State) -> end end. +find_function({_, _, _} = MFA, _State) -> + MFA; +find_function(top, _State) -> + top; +find_function(FunLbl, #state{fun_homes = Homes}) -> + dict:fetch(FunLbl, Homes). + classify_returns(Tree) -> case find_terminals(cerl:fun_body(Tree)) of {false, false} -> no_match; diff --git a/lib/dialyzer/src/dialyzer_options.erl b/lib/dialyzer/src/dialyzer_options.erl index a92b8b1958..20971f1407 100644 --- a/lib/dialyzer/src/dialyzer_options.erl +++ b/lib/dialyzer/src/dialyzer_options.erl @@ -28,7 +28,7 @@ -module(dialyzer_options). --export([build/1]). +-export([build/1, build_warnings/2]). -include("dialyzer.hrl"). @@ -270,7 +270,7 @@ assert_solvers([v2|Terms]) -> assert_solvers([Term|_]) -> bad_option("Illegal value for solver", Term). --spec build_warnings([atom()], [dial_warning()]) -> [dial_warning()]. +-spec build_warnings([atom()], dial_warn_tags()) -> dial_warn_tags(). build_warnings([Opt|Opts], Warnings) -> NewWarnings = diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl index 2a8aba5d8f..48eb331239 100644 --- a/lib/dialyzer/src/dialyzer_races.erl +++ b/lib/dialyzer/src/dialyzer_races.erl @@ -85,9 +85,9 @@ -type race_tag() :: 'whereis_register' | 'whereis_unregister' | 'ets_lookup_insert' | 'mnesia_dirty_read_write'. -%% The following type is similar to the dial_warning() type but has a +%% The following type is similar to the raw_warning() type but has a %% tag which is local to this module and is not propagated to outside --type dial_race_warning() :: {race_warn_tag(), file_line(), {atom(), [term()]}}. +-type dial_race_warning() :: {race_warn_tag(), warning_info(), {atom(), [term()]}}. -type race_warn_tag() :: ?WARN_WHEREIS_REGISTER | ?WARN_WHEREIS_UNREGISTER | ?WARN_ETS_LOOKUP_INSERT | ?WARN_MNESIA_DIRTY_READ_WRITE. @@ -312,10 +312,13 @@ race(State) -> DepList = fixup_race_list(RaceWarnTag, VarArgs, State1), {State2, RaceWarn} = get_race_warn(Fun, Args, ArgTypes, DepList, State), + {File, Line} = FileLine, + CurrMFA = dialyzer_dataflow:state__find_function(CurrFun, State), + WarningInfo = {File, Line, CurrMFA}, race( state__add_race_warning( state__renew_race_tags(T, State2), RaceWarn, RaceWarnTag, - FileLine)) + WarningInfo)) end, state__renew_race_tags([], RetState). @@ -2324,7 +2327,7 @@ get_race_warnings_helper(Warnings, State) -> [] -> {dialyzer_dataflow:state__get_races(State), State}; [H|T] -> - {RaceWarnTag, FileLine, {race_condition, [M, F, A, AT, S, DepList]}} = H, + {RaceWarnTag, WarningInfo, {race_condition, [M, F, A, AT, S, DepList]}} = H, Reason = case RaceWarnTag of ?WARN_WHEREIS_REGISTER -> @@ -2347,7 +2350,7 @@ get_race_warnings_helper(Warnings, State) -> "caused by its combination with ") end, W = - {?WARN_RACE_CONDITION, FileLine, + {?WARN_RACE_CONDITION, WarningInfo, {race_condition, [M, F, dialyzer_dataflow:format_args(A, AT, S), Reason]}}, get_race_warnings_helper(T, @@ -2377,12 +2380,12 @@ get_reason(DependencyList, Reason) -> end end. -state__add_race_warning(State, RaceWarn, RaceWarnTag, FileLine) -> +state__add_race_warning(State, RaceWarn, RaceWarnTag, WarningInfo) -> case RaceWarn of no_race -> State; _Else -> Races = dialyzer_dataflow:state__get_races(State), - Warn = {RaceWarnTag, FileLine, RaceWarn}, + Warn = {RaceWarnTag, WarningInfo, RaceWarn}, dialyzer_dataflow:state__put_races(add_race_warning(Warn, Races), State) end. diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index 6dc4285194..7ceb19e30a 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -29,7 +29,7 @@ -export([analyze_callgraph/3, analyze_callgraph/6, - get_warnings/8 + get_warnings/7 ]). -export([ @@ -69,10 +69,8 @@ -type scc() :: [mfa_or_funlbl()] | [module()]. - -record(st, {callgraph :: dialyzer_callgraph:callgraph(), codeserver :: dialyzer_codeserver:codeserver(), - no_warn_unused :: sets:set(mfa()), parent = none :: parent(), timing_server :: dialyzer_timing:timing_server(), solvers :: [solver()], @@ -137,18 +135,17 @@ get_refined_success_typings(SCCs, #st{callgraph = Callgraph, -type doc_plt() :: 'undefined' | dialyzer_plt:plt(). -spec get_warnings(dialyzer_callgraph:callgraph(), dialyzer_plt:plt(), - doc_plt(), dialyzer_codeserver:codeserver(), sets:set(mfa()), + doc_plt(), dialyzer_codeserver:codeserver(), dialyzer_timing:timing_server(), [solver()], pid()) -> - {[dial_warning()], dialyzer_plt:plt(), doc_plt()}. + {[raw_warning()], dialyzer_plt:plt(), doc_plt()}. get_warnings(Callgraph, Plt, DocPlt, Codeserver, - NoWarnUnused, TimingServer, Solvers, Parent) -> + TimingServer, Solvers, Parent) -> InitState = init_state_and_get_success_typings(Callgraph, Plt, Codeserver, TimingServer, Solvers, Parent), - NewState = InitState#st{no_warn_unused = NoWarnUnused}, - Mods = dialyzer_callgraph:modules(NewState#st.callgraph), - MiniPlt = NewState#st.plt, + Mods = dialyzer_callgraph:modules(InitState#st.callgraph), + MiniPlt = InitState#st.plt, FindOpaques = lookup_and_find_opaques_fun(Codeserver), CWarns = dialyzer_contracts:get_invalid_contract_warnings(Mods, Codeserver, @@ -156,31 +153,30 @@ get_warnings(Callgraph, Plt, DocPlt, Codeserver, MiniDocPlt = dialyzer_plt:get_mini_plt(DocPlt), ModWarns = ?timing(TimingServer, "warning", - get_warnings_from_modules(Mods, NewState, MiniDocPlt)), + get_warnings_from_modules(Mods, InitState, MiniDocPlt)), {postprocess_warnings(CWarns ++ ModWarns, Codeserver), dialyzer_plt:restore_full_plt(MiniPlt, Plt), dialyzer_plt:restore_full_plt(MiniDocPlt, DocPlt)}. get_warnings_from_modules(Mods, State, DocPlt) -> #st{callgraph = Callgraph, codeserver = Codeserver, - no_warn_unused = NoWarnUnused, plt = Plt, - timing_server = TimingServer} = State, - Init = {Codeserver, Callgraph, NoWarnUnused, Plt, DocPlt}, + plt = Plt, timing_server = TimingServer} = State, + Init = {Codeserver, Callgraph, Plt, DocPlt}, dialyzer_coordinator:parallel_job(warnings, Mods, Init, TimingServer). --spec collect_warnings(module(), warnings_init_data()) -> [dial_warning()]. +-spec collect_warnings(module(), warnings_init_data()) -> [raw_warning()]. -collect_warnings(M, {Codeserver, Callgraph, NoWarnUnused, Plt, DocPlt}) -> +collect_warnings(M, {Codeserver, Callgraph, Plt, DocPlt}) -> ModCode = dialyzer_codeserver:lookup_mod_code(M, Codeserver), Records = dialyzer_codeserver:lookup_mod_records(M, Codeserver), Contracts = dialyzer_codeserver:lookup_mod_contracts(M, Codeserver), AllFuns = collect_fun_info([ModCode]), %% Check if there are contracts for functions that do not exist - Warnings1 = + Warnings1 = dialyzer_contracts:contracts_without_fun(Contracts, AllFuns, Callgraph), {Warnings2, FunTypes} = - dialyzer_dataflow:get_warnings(ModCode, Plt, Callgraph, - Records, NoWarnUnused), + dialyzer_dataflow:get_warnings(ModCode, Plt, Callgraph, Codeserver, + Records), Attrs = cerl:module_attrs(ModCode), Warnings3 = dialyzer_behaviours:check_callbacks(M, Attrs, Records, Plt, Codeserver), @@ -197,17 +193,19 @@ postprocess_warnings(RawWarnings, Codeserver) -> postprocess_dataflow_warns([], _Callgraph, WAcc, Acc) -> lists:reverse(Acc, WAcc); -postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {CallF, CallL}, Msg}|Rest], +postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, WarningInfo, Msg}|Rest], Codeserver, WAcc, Acc) -> + {CallF, CallL, _CallMFA} = WarningInfo, {contract_range, [Contract, M, F, A, ArgStrings, CRet]} = Msg, case dialyzer_codeserver:lookup_mfa_contract({M,F,A}, Codeserver) of - {ok, {{ContrF, _ContrL} = FileLine, _C, _X}} -> + {ok, {{ContrF, ContrL}, _C, _X}} -> case CallF =:= ContrF of true -> NewMsg = {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]}, - W = {?WARN_CONTRACT_RANGE, FileLine, NewMsg}, + WarningInfo2 = {ContrF, ContrL, {M, F, A}}, + W = {?WARN_CONTRACT_RANGE, WarningInfo2, NewMsg}, Filter = - fun({?WARN_CONTRACT_TYPES, FL, _}) when FL =:= FileLine -> false; + fun({?WARN_CONTRACT_TYPES, WI, _}) when WI =:= WarningInfo2 -> false; (_) -> true end, FilterWAcc = lists:filter(Filter, WAcc), @@ -219,7 +217,7 @@ postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {CallF, CallL}, Msg}|Rest], %% The contract is not in a module that is currently under analysis. %% We display the warning in the file/line of the call. NewMsg = {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]}, - W = {?WARN_CONTRACT_RANGE, {CallF, CallL}, NewMsg}, + W = {?WARN_CONTRACT_RANGE, WarningInfo, NewMsg}, postprocess_dataflow_warns(Rest, Codeserver, WAcc, [W|Acc]) end. @@ -262,7 +260,7 @@ refine_one_module(M, {CodeServer, Callgraph, Plt, _Solvers}) -> Records = dialyzer_codeserver:lookup_mod_records(M, CodeServer), FunTypes = get_fun_types_from_plt(AllFuns, Callgraph, Plt), NewFunTypes = - dialyzer_dataflow:get_fun_types(ModCode, Plt, Callgraph, Records), + dialyzer_dataflow:get_fun_types(ModCode, Plt, Callgraph, CodeServer, Records), Contracts1 = dialyzer_codeserver:lookup_mod_contracts(M, CodeServer), Contracts = orddict:from_list(dict:to_list(Contracts1)), FindOpaques = find_opaques_fun(Records), diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 3d03ed3ab3..217d238712 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -3275,7 +3275,7 @@ is_literal_record(Tree) -> lists:member(record, Ann). family(L) -> - sofs:to_external(sofs:rel2fam(sofs:relation(L))). + dialyzer_utils:family(L). %% ============================================================================ %% diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index e5f5c69d45..01ade00664 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -40,12 +40,16 @@ get_core_from_src/2, get_record_and_type_info/1, get_spec_info/3, + get_fun_meta_info/3, + is_suppressed_fun/2, + is_suppressed_tag/3, merge_records/2, pp_hook/0, process_record_remote_types/1, sets_filter/2, src_compiler_opts/0, - parallelism/0 + parallelism/0, + family/1 ]). -include("dialyzer.hrl"). @@ -80,7 +84,9 @@ print_types1([{record, _Name} = Key|T], RecDict) -> -type abstract_code() :: [tuple()]. %% XXX: import from somewhere -type comp_options() :: [compile:option()]. --type mod_or_fname() :: atom() | file:filename(). +-type mod_or_fname() :: module() | file:filename(). +-type fa() :: {atom(), arity()}. +-type codeserver() :: dialyzer_codeserver:codeserver(). %% ============================================================================ %% @@ -300,7 +306,7 @@ type_record_fields([RecKey|Recs], RecDict) -> {error, Name, Error} end. --spec process_record_remote_types(dialyzer_codeserver:codeserver()) -> dialyzer_codeserver:codeserver(). +-spec process_record_remote_types(codeserver()) -> codeserver(). process_record_remote_types(CServer) -> TempRecords = dialyzer_codeserver:get_temp_records(CServer), @@ -341,7 +347,7 @@ merge_records(NewRecords, OldRecords) -> -type spec_dict() :: dict:dict(). -type callback_dict() :: dict:dict(). --spec get_spec_info(atom(), abstract_code(), dict:dict()) -> +-spec get_spec_info(module(), abstract_code(), dict:dict()) -> {'ok', spec_dict(), callback_dict()} | {'error', string()}. get_spec_info(ModName, AbstractCode, RecordsDict) -> @@ -359,13 +365,6 @@ get_optional_callbacks(Abs) -> is_fa_list(O)], lists:append(L). -is_fa_list([{FuncName, Arity}|L]) - when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> - is_fa_list(L); -is_fa_list([]) -> true; -is_fa_list(_) -> false. - - %% TypeSpec is a list of conditional contracts for a function. %% Each contract is of the form {[Argument], Range, [Constraint]} where %% - Argument and Range are in erl_types:erl_type() format and @@ -422,6 +421,126 @@ get_spec_info([], SpecDict, CallbackDict, _RecordsDict, _ModName, _OptCb, _File) -> {ok, SpecDict, CallbackDict}. +-spec get_fun_meta_info(module(), abstract_code(), [dial_warn_tag()]) -> + dialyzer_codeserver:fun_meta_info(). + +get_fun_meta_info(M, Abs, LegalWarnings) -> + NoWarn = get_nowarn_unused_function(M, Abs), + FuncSupp = get_func_suppressions(M, Abs), + Warnings0 = get_options(Abs, LegalWarnings), + Warnings = ordsets:to_list(Warnings0), + ModuleWarnings = [{M, W} || W <- Warnings], + RawProps = lists:append([NoWarn, FuncSupp, ModuleWarnings]), + process_options(dialyzer_utils:family(RawProps), Warnings0). + +process_options([{M, _}=Mod|Left], Warnings) when is_atom(M) -> + [Mod|process_options(Left, Warnings)]; +process_options([{{_M, _F, _A}=MFA, Opts}|Left], Warnings) -> + WL = case lists:member(nowarn_function, Opts) of + true -> [{nowarn_function, func}]; % takes precedence + false -> + Ws = dialyzer_options:build_warnings(Opts, Warnings), + ModOnly = [{W, mod} || W <- ordsets:subtract(Warnings, Ws)], + FunOnly = [{W, func} || W <- ordsets:subtract(Ws, Warnings)], + ordsets:union(ModOnly, FunOnly) + end, + case WL of + [] -> process_options(Left, Warnings); + _ -> [{MFA, WL}|process_options(Left, Warnings)] + end; +process_options([], _Warnings) -> []. + +-spec get_nowarn_unused_function(module(), abstract_code()) -> + [{mfa(), 'no_unused'}]. + +get_nowarn_unused_function(M, Abs) -> + Opts = get_options_with_tag(compile, Abs), + Warn = erl_lint:bool_option(warn_unused_function, nowarn_unused_function, + true, Opts), + Functions = [{F, A} || {function, _, F, A, _} <- Abs], + AttrFile = collect_attribute(Abs, compile), + TagsFaList = check_fa_list(AttrFile, nowarn_unused_function, Functions), + FAs = case Warn of + false -> Functions; + true -> + [FA || {{nowarn_unused_function,_L,_File}, FA} <- TagsFaList] + end, + [{{M, F, A}, no_unused} || {F, A} <- FAs]. + +-spec get_func_suppressions(module(), abstract_code()) -> + [{mfa(), 'nowarn_function' | dial_warn_tag()}]. + +get_func_suppressions(M, Abs) -> + Functions = [{F, A} || {function, _, F, A, _} <- Abs], + AttrFile = collect_attribute(Abs, dialyzer), + TagsFAs = check_fa_list(AttrFile, '*', Functions), + %% Check the options: + Fun = fun({{nowarn_function, _L, _File}, _FA}) -> ok; + ({OptLFile, _FA}) -> + _ = get_options1([OptLFile], ordsets:new()) + end, + lists:foreach(Fun, TagsFAs), + [{{M, F, A}, W} || {{W, _L, _File}, {F, A}} <- TagsFAs]. + +-spec get_options(abstract_code(), [dial_warn_tag()]) -> + ordsets:ordset(dial_warn_tag()). + +get_options(Abs, LegalWarnings) -> + AttrFile = collect_attribute(Abs, dialyzer), + get_options1(AttrFile, LegalWarnings). + +get_options1([{Args, L, File}|Left], Warnings) -> + Opts = [O || + O <- lists:flatten([Args]), + is_atom(O)], + try dialyzer_options:build_warnings(Opts, Warnings) of + NewWarnings -> + get_options1(Left, NewWarnings) + catch + throw:{dialyzer_options_error, Msg} -> + Msg1 = flat_format(" ~s:~w: ~s", [File, L, Msg]), + throw({error, Msg1}) + end; +get_options1([], Warnings) -> + Warnings. + +-type collected_attribute() :: + {Args :: term(), erl_scan:line(), file:filename()}. + +collect_attribute(Abs, Tag) -> + collect_attribute(Abs, Tag, "nofile"). + +collect_attribute([{attribute, L, Tag, Args}|Left], Tag, File) -> + CollAttr = {Args, L, File}, + [CollAttr | collect_attribute(Left, Tag, File)]; +collect_attribute([{attribute, _, file, {IncludeFile, _}}|Left], Tag, _) -> + collect_attribute(Left, Tag, IncludeFile); +collect_attribute([_Other|Left], Tag, File) -> + collect_attribute(Left, Tag, File); +collect_attribute([], _Tag, _File) -> []. + +-spec is_suppressed_fun(mfa(), codeserver()) -> boolean(). + +is_suppressed_fun(MFA, CodeServer) -> + lookup_fun_property(MFA, nowarn_function, CodeServer). + +-spec is_suppressed_tag(mfa() | module(), dial_warn_tag(), codeserver()) -> + boolean(). + +is_suppressed_tag(MorMFA, Tag, Codeserver) -> + not lookup_fun_property(MorMFA, Tag, Codeserver). + +lookup_fun_property({M, _F, _A}=MFA, Property, CodeServer) -> + MFAPropList = dialyzer_codeserver:lookup_meta_info(MFA, CodeServer), + case proplists:get_value(Property, MFAPropList, no) of + mod -> false; % suppressed in function + func -> true; % requested in function + no -> lookup_fun_property(M, Property, CodeServer) + end; +lookup_fun_property(M, Property, CodeServer) when is_atom(M) -> + MPropList = dialyzer_codeserver:lookup_meta_info(M, CodeServer), + proplists:is_defined(Property, MPropList). + %% ============================================================================ %% %% Exported types @@ -503,6 +622,57 @@ format_sig(Type, RecDict) -> flat_format(Fmt, Lst) -> lists:flatten(io_lib:format(Fmt, Lst)). +-spec get_options_with_tag(atom(), abstract_code()) -> [term()]. + +get_options_with_tag(Tag, Abs) -> + lists:flatten([O || {attribute, _, Tag0, O} <- Abs, Tag =:= Tag0]). + +%% Check F/A, and collect (unchecked) warning tags with line and file. +-spec check_fa_list([collected_attribute()], atom(), [fa()]) -> + [{{atom(), erl_scan:line(), file:filename()},fa()}]. + +check_fa_list(AttrFile, Tag, Functions) -> + FuncTab = gb_sets:from_list(Functions), + check_fa_list1(AttrFile, Tag, FuncTab). + +check_fa_list1([{Args, L, File}|Left], Tag, Funcs) -> + TermsL = [{{Tag0, L, File}, Term} || + {Tags, Terms0} <- lists:flatten([Args]), + Tag0 <- lists:flatten([Tags]), + Tag =:= '*' orelse Tag =:= Tag0, + Term <- lists:flatten([Terms0])], + case lists:dropwhile(fun({_, T}) -> is_fa(T) end, TermsL) of + [] -> ok; + [{_, Bad}|_] -> + Msg1 = flat_format(" Bad function ~w in line ~s:~w", + [Bad, File, L]), + throw({error, Msg1}) + end, + case lists:dropwhile(fun({_, FA}) -> is_known(FA, Funcs) end, TermsL) of + [] -> ok; + [{_, {F, A}}|_] -> + Msg2 = flat_format(" Unknown function ~w/~w in line ~s:~w", + [F, A, File, L]), + throw({error, Msg2}) + end, + TermsL ++ check_fa_list1(Left, Tag, Funcs); +check_fa_list1([], _Tag, _Funcs) -> []. + +is_known(FA, Funcs) -> + gb_sets:is_element(FA, Funcs). + +-spec is_fa_list(term()) -> boolean(). + +is_fa_list([E|L]) -> is_fa(E) andalso is_fa_list(L); +is_fa_list([]) -> true; +is_fa_list(_) -> false. + +-spec is_fa(term()) -> boolean(). + +is_fa({FuncName, Arity}) + when is_atom(FuncName), is_integer(Arity), Arity >= 0 -> true; +is_fa(_) -> false. + %%------------------------------------------------------------------- %% Author : Per Gustafsson <[email protected]> %% Description : Provides better printing of binaries. @@ -607,3 +777,8 @@ parallelism() -> CPUs = erlang:system_info(logical_processors_available), Schedulers = erlang:system_info(schedulers), min(CPUs, Schedulers). + +-spec family([{K,V}]) -> [{K,[V]}]. + +family(L) -> + sofs:to_external(sofs:rel2fam(sofs:relation(L))). diff --git a/lib/dialyzer/test/race_SUITE_data/src/ets_insert_args1_suppressed.erl b/lib/dialyzer/test/race_SUITE_data/src/ets_insert_args1_suppressed.erl new file mode 100644 index 0000000000..5134cc6f0b --- /dev/null +++ b/lib/dialyzer/test/race_SUITE_data/src/ets_insert_args1_suppressed.erl @@ -0,0 +1,19 @@ +%% This tests the presence of possible races due to an ets:lookup/ets:insert +%% combination. It takes into account the argument types of the calls. + +-module(ets_insert_args1_suppressed). +-export([start/0]). + +-dialyzer({nowarn_function,start/0}). + +start() -> + F = fun(T) -> [{_, N}] = ets:lookup(T, counter), + ets:insert(T, [{counter, N+1}]) + end, + io:format("Created ~w\n", [ets:new(foo, [named_table, public])]), + ets:insert(foo, {counter, 0}), + io:format("Inserted ~w\n", [{counter, 0}]), + F(foo), + io:format("Update complete\n", []), + ObjectList = ets:lookup(foo, counter), + io:format("Counter: ~w\n", [ObjectList]). diff --git a/lib/dialyzer/test/small_SUITE_data/results/blame_contract_range_suppressed b/lib/dialyzer/test/small_SUITE_data/results/blame_contract_range_suppressed new file mode 100644 index 0000000000..40733434f6 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/blame_contract_range_suppressed @@ -0,0 +1,2 @@ + +blame_contract_range_suppressed.erl:8: Function foo/0 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/request1 b/lib/dialyzer/test/small_SUITE_data/results/request1 new file mode 100644 index 0000000000..0cf4017403 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/request1 @@ -0,0 +1,2 @@ + +request1.erl:8: Expression produces a value of type {'a','b'}, but this value is unmatched diff --git a/lib/dialyzer/test/small_SUITE_data/results/suppress_request b/lib/dialyzer/test/small_SUITE_data/results/suppress_request new file mode 100644 index 0000000000..18e82b7972 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/suppress_request @@ -0,0 +1,6 @@ + +suppress_request.erl:21: Expression produces a value of type {'a','b'}, but this value is unmatched +suppress_request.erl:25: Expression produces a value of type {'a','b'}, but this value is unmatched +suppress_request.erl:35: Function test3_b/0 has no local return +suppress_request.erl:39: Guard test 2 =:= A::fun((none()) -> no_return()) can never succeed +suppress_request.erl:7: Type specification suppress_request:test1('a' | 'b') -> 'ok' is a subtype of the success typing: suppress_request:test1('a' | 'b' | 'c') -> 'ok' diff --git a/lib/dialyzer/test/small_SUITE_data/src/blame_contract_range_suppressed.erl b/lib/dialyzer/test/small_SUITE_data/src/blame_contract_range_suppressed.erl new file mode 100644 index 0000000000..8b66d35083 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/blame_contract_range_suppressed.erl @@ -0,0 +1,15 @@ +%%----------------------------------------------------------------------- +%% Like ./blame_contract_range.erl, but warning is suppressed. +%%----------------------------------------------------------------------- +-module(blame_contract_range_suppressed). + +-export([foo/0]). + +foo() -> + bar(b). + +-dialyzer({nowarn_function, bar/1}). + +-spec bar(atom()) -> a. +bar(a) -> a; +bar(b) -> b. diff --git a/lib/dialyzer/test/small_SUITE_data/src/request1.erl b/lib/dialyzer/test/small_SUITE_data/src/request1.erl new file mode 100644 index 0000000000..a6c4ab8dbd --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/request1.erl @@ -0,0 +1,12 @@ +-module(request1). + +-export([a/0]). + +-dialyzer(unmatched_returns). + +a() -> + b(), + 1. + +b() -> + {a, b}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/suppress_request.erl b/lib/dialyzer/test/small_SUITE_data/src/suppress_request.erl new file mode 100644 index 0000000000..c4275fa110 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/suppress_request.erl @@ -0,0 +1,50 @@ +-module(suppress_request). + +-export([test1/1, test1_b/1, test2/0, test2_b/0, + test3/0, test3_b/0, test4/0, test4_b/0]). + +-dialyzer({[specdiffs], test1/1}). +-spec test1(a | b) -> ok. % spec is subtype +test1(A) -> + ok = test1_1(A). + +-spec test1_b(a | b) -> ok. % spec is subtype (suppressed by default) +test1_b(A) -> + ok = test1_1(A). + +-spec test1_1(a | b | c) -> ok. +test1_1(_) -> + ok. + +-dialyzer(unmatched_returns). +test2() -> + tuple(), % unmatched + ok. + +test2_b() -> + tuple(), % unmatched + ok. + +-dialyzer({[no_return, no_match], [test3/0]}). +test3() -> % no local return (suppressed) + A = fun(_) -> + 1 + end, + A = 2. % can never succeed (suppressed) + +test3_b() -> % no local return (requested by default) + A = fun(_) -> + 1 + end, + A = 2. % can never succeed (requested by default) + +-dialyzer(no_improper_lists). +test4() -> + [1 | 2]. % improper list (suppressed) + +-dialyzer({no_improper_lists, test4_b/0}). +test4_b() -> + [1 | 2]. % improper list (suppressed) + +tuple() -> + {a, b}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/suppression1.erl b/lib/dialyzer/test/small_SUITE_data/src/suppression1.erl new file mode 100644 index 0000000000..00534704c3 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/suppression1.erl @@ -0,0 +1,33 @@ +-module(suppression1). + +-export([a/1, b/1, c/0]). + +-dialyzer({nowarn_function, a/1}). + +-spec a(_) -> integer(). + +a(_) -> + A = fun(_) -> + B = fun(_) -> + x = 7 + end, + B = 1 + end, + A. + +-spec b(_) -> integer(). + +-dialyzer({nowarn_function, b/1}). + +b(_) -> + A = fun(_) -> + 1 + end, + A = 2. + +-record(r, {a = a :: integer()}). + +-dialyzer({nowarn_function, c/0}). + +c() -> + #r{}. diff --git a/lib/dialyzer/test/small_SUITE_data/src/suppression2.erl b/lib/dialyzer/test/small_SUITE_data/src/suppression2.erl new file mode 100644 index 0000000000..4cba53fdce --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/suppression2.erl @@ -0,0 +1,32 @@ +-module(suppression2). + +-export([a/1, b/1, c/0]). + +-dialyzer({nowarn_function, [a/1, b/1, c/0]}). +-dialyzer([no_undefined_callbacks]). + +-behaviour(not_a_behaviour). + +-spec a(_) -> integer(). + +a(_) -> + A = fun(_) -> + B = fun(_) -> + x = 7 + end, + B = 1 + end, + A. + +-spec b(_) -> integer(). + +b(_) -> + A = fun(_) -> + 1 + end, + A = 2. + +-record(r, {a = a :: integer()}). + +c() -> + #r{}. diff --git a/lib/hipe/ppc/hipe_rtl_to_ppc.erl b/lib/hipe/ppc/hipe_rtl_to_ppc.erl index 7dfa56df29..a55fc137c3 100644 --- a/lib/hipe/ppc/hipe_rtl_to_ppc.erl +++ b/lib/hipe/ppc/hipe_rtl_to_ppc.erl @@ -102,10 +102,18 @@ conv_insn(I, Map, Data) -> end. conv_fconv(I, Map, Data) -> - %% Dst := (double)Src, where Dst is FP reg and Src is int reg + %% Dst := (double)Src, where Dst is FP reg and Src is GP reg or imm {Dst, Map0} = conv_fpreg(hipe_rtl:fconv_dst(I), Map), - {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), % exclude imm src - I2 = mk_fconv(Dst, Src), + {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), + I2 = + case hipe_ppc:is_temp(Src) of + true -> + mk_fconv(Dst, Src); + false -> + Tmp = new_untagged_temp(), + mk_li(Tmp, Src, + mk_fconv(Dst, Tmp)) + end, {I2, Map1, Data}. mk_fconv(Dst, Src) -> diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl index bc61bec0bd..2f62dd79ad 100644 --- a/lib/hipe/rtl/hipe_rtl.erl +++ b/lib/hipe/rtl/hipe_rtl.erl @@ -413,11 +413,11 @@ rtl_info_update(Rtl, Info) -> Rtl#rtl{info=Info}. %% move %% -mk_move(Dst, Src) -> #move{dst=Dst, src=Src}. +mk_move(Dst, Src) -> false = is_fpreg(Dst), false = is_fpreg(Src), #move{dst=Dst, src=Src}. move_dst(#move{dst=Dst}) -> Dst. -move_dst_update(M, NewDst) -> M#move{dst=NewDst}. +move_dst_update(M, NewDst) -> false = is_fpreg(NewDst), M#move{dst=NewDst}. move_src(#move{src=Src}) -> Src. -move_src_update(M, NewSrc) -> M#move{src=NewSrc}. +move_src_update(M, NewSrc) -> false = is_fpreg(NewSrc), M#move{src=NewSrc}. %% is_move(#move{}) -> true; %% is_move(_) -> false. @@ -469,7 +469,11 @@ phi_remove_pred(Phi, Pred) -> case NewArgList of [Arg] -> %% the phi should be turned into a move instruction {_Label,Var} = Arg, - mk_move(phi_dst(Phi), Var); + Dst = phi_dst(Phi), + case {is_fpreg(Dst), is_fpreg(Var)} of + {true, true} -> mk_fmove(Dst, Var); + {false, false} -> mk_move(Dst, Var) + end; %% io:format("~nPhi (~w) turned into move (~w) when removing pred ~w~n",[Phi,Move,Pred]), [_|_] -> Phi#phi{arglist=NewArgList} @@ -836,11 +840,11 @@ fp_unop_op(#fp_unop{op=Op}) -> Op. %% fmove %% -mk_fmove(X, Y) -> #fmove{dst=X, src=Y}. +mk_fmove(X, Y) -> true = is_fpreg(X), true = is_fpreg(Y), #fmove{dst=X, src=Y}. fmove_dst(#fmove{dst=Dst}) -> Dst. -fmove_dst_update(M, NewDst) -> M#fmove{dst=NewDst}. +fmove_dst_update(M, NewDst) -> true = is_fpreg(NewDst), M#fmove{dst=NewDst}. fmove_src(#fmove{src=Src}) -> Src. -fmove_src_update(M, NewSrc) -> M#fmove{src=NewSrc}. +fmove_src_update(M, NewSrc) -> true = is_fpreg(NewSrc), M#fmove{src=NewSrc}. %% %% fconv diff --git a/lib/hipe/sparc/hipe_rtl_to_sparc.erl b/lib/hipe/sparc/hipe_rtl_to_sparc.erl index dc001f865e..fd21be3ae7 100644 --- a/lib/hipe/sparc/hipe_rtl_to_sparc.erl +++ b/lib/hipe/sparc/hipe_rtl_to_sparc.erl @@ -85,17 +85,17 @@ conv_insn(I, Map, Data) -> end. conv_fconv(I, Map, Data) -> - %% Dst := (double)Src, where Dst is FP reg and Src is int reg - {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map), % exclude imm src + %% Dst := (double)Src, where Dst is FP reg and Src is GP reg or imm + {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map), {Dst, Map2} = conv_fpreg(hipe_rtl:fconv_dst(I), Map1), I2 = mk_fconv(Src, Dst), {I2, Map2, Data}. mk_fconv(Src, Dst) -> CSP = hipe_sparc:mk_temp(14, 'untagged'), % o6 - Disp = hipe_sparc:mk_simm13(100), - [hipe_sparc:mk_store('stw', Src, CSP, Disp), - hipe_sparc:mk_pseudo_fload(CSP, Disp, Dst, true), + Offset = 100, + mk_store('stw', Src, CSP, Offset) ++ + [hipe_sparc:mk_pseudo_fload(CSP, hipe_sparc:mk_simm13(Offset), Dst, true), hipe_sparc:mk_fp_unary('fitod', Dst, Dst)]. conv_fmove(I, Map, Data) -> diff --git a/lib/hipe/x86/hipe_rtl_to_x86.erl b/lib/hipe/x86/hipe_rtl_to_x86.erl index d77e4fed3b..36da2f4d44 100644 --- a/lib/hipe/x86/hipe_rtl_to_x86.erl +++ b/lib/hipe/x86/hipe_rtl_to_x86.erl @@ -236,7 +236,7 @@ conv_insn(I, Map, Data) -> #fconv{} -> {Dst, Map0} = conv_dst(hipe_rtl:fconv_dst(I), Map), {[], Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), - I2 = [hipe_x86:mk_fmove(Src, Dst)], + I2 = conv_fconv(Dst, Src), {I2, Map1, Data}; X -> %% gctest?? @@ -712,6 +712,19 @@ vmap_lookup(Map, Key) -> vmap_bind(Map, Key, Val) -> gb_trees:insert(Key, Val, Map). +%%% Finalise the conversion of an Integer-to-Float operation. + +conv_fconv(Dst, Src) -> + case hipe_x86:is_imm(Src) of + false -> + [hipe_x86:mk_fmove(Src, Dst)]; + true -> + %% cvtsi2sd does not allow src to be an immediate + Tmp = new_untagged_temp(), + [hipe_x86:mk_move(Src, Tmp), + hipe_x86:mk_fmove(Tmp, Dst)] + end. + %%% Finalise the conversion of a 2-address FP operation. conv_fp_unary(Dst, Src, FpUnOp) -> diff --git a/lib/inets/src/http_client/httpc_cookie.erl b/lib/inets/src/http_client/httpc_cookie.erl index 134115bdfa..5d71a0bb8f 100644 --- a/lib/inets/src/http_client/httpc_cookie.erl +++ b/lib/inets/src/http_client/httpc_cookie.erl @@ -334,9 +334,23 @@ add_domain(Str, #http_cookie{domain_default = true}) -> add_domain(Str, #http_cookie{domain = Domain}) -> Str ++ "; $Domain=" ++ Domain. +is_set_cookie_valid("") -> + %% an empty Set-Cookie header is not valid + false; +is_set_cookie_valid([$=|_]) -> + %% a Set-Cookie header without name is not valid + false; +is_set_cookie_valid(SetCookieHeader) -> + %% a Set-Cookie header without name/value is not valid + case string:chr(SetCookieHeader, $=) of + 0 -> false; + _ -> true + end. + parse_set_cookies(CookieHeaders, DefaultPathDomain) -> - %% empty Set-Cookie header is invalid according to RFC but some sites violate it - SetCookieHeaders = [Value || {"set-cookie", Value} <- CookieHeaders, Value /= ""], + %% filter invalid Set-Cookie headers + SetCookieHeaders = [Value || {"set-cookie", Value} <- CookieHeaders, + is_set_cookie_valid(Value)], Cookies = [parse_set_cookie(SetCookieHeader, DefaultPathDomain) || SetCookieHeader <- SetCookieHeaders], %% print_cookies("Parsed Cookies", Cookies), diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index 63f8bc5bc6..82e08a52cd 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -92,6 +92,7 @@ only_simulated() -> cookie, cookie_profile, empty_set_cookie, + invalid_set_cookie, trace, stream_once, stream_single_chunk, @@ -570,6 +571,18 @@ empty_set_cookie(Config) when is_list(Config) -> ok = httpc:set_options([{cookies, disabled}]). %%------------------------------------------------------------------------- +invalid_set_cookie(doc) -> + ["Test ignoring invalid Set-Cookie header"]; +invalid_set_cookie(Config) when is_list(Config) -> + ok = httpc:set_options([{cookies, enabled}]), + + URL = url(group_name(Config), "/invalid_set_cookie.html", Config), + {ok, {{_,200,_}, [_|_], [_|_]}} = + httpc:request(get, {URL, []}, [], []), + + ok = httpc:set_options([{cookies, disabled}]). + +%%------------------------------------------------------------------------- headers_as_is(doc) -> ["Test the option headers_as_is"]; headers_as_is(Config) when is_list(Config) -> @@ -1715,6 +1728,13 @@ handle_uri(_,"/empty_set_cookie.html",_,_,_,_) -> "Content-Length:32\r\n\r\n"++ "<HTML><BODY>foobar</BODY></HTML>"; +handle_uri(_,"/invalid_set_cookie.html",_,_,_,_) -> + "HTTP/1.1 200 ok\r\n" ++ + "set-cookie: =\r\n" ++ + "set-cookie: name-or-value\r\n" ++ + "Content-Length:32\r\n\r\n"++ + "<HTML><BODY>foobar</BODY></HTML>"; + handle_uri(_,"/missing_crlf.html",_,_,_,_) -> "HTTP/1.1 200 ok" ++ "Content-Length:32\r\n" ++ diff --git a/lib/kernel/src/standard_error.erl b/lib/kernel/src/standard_error.erl index 10cf77e0d4..1c43063937 100644 --- a/lib/kernel/src/standard_error.erl +++ b/lib/kernel/src/standard_error.erl @@ -63,7 +63,7 @@ server(PortName,PortSettings) -> run(Port). run(P) -> - put(unicode,false), + put(encoding, latin1), server_loop(P). server_loop(Port) -> @@ -95,25 +95,47 @@ do_io_request(Req, From, ReplyAs, Port) -> io_reply(From, ReplyAs, Reply). %% New in R13B -% Wide characters (Unicode) -io_request({put_chars,Encoding,Chars}, Port) -> % Binary new in R9C - put_chars(wrap_characters_to_binary(Chars,Encoding, - case get(unicode) of - true -> unicode; - _ -> latin1 - end), Port); -io_request({put_chars,Encoding,Mod,Func,Args}, Port) -> - Result = case catch apply(Mod,Func,Args) of - Data when is_list(Data); is_binary(Data) -> - wrap_characters_to_binary(Data,Encoding, - case get(unicode) of - true -> unicode; - _ -> latin1 - end); - Undef -> - Undef - end, - put_chars(Result, Port); +%% Encoding option (unicode/latin1) +io_request({put_chars,unicode,Chars}, Port) -> + case wrap_characters_to_binary(Chars, unicode, get(encoding)) of + error -> + {error,{error,put_chars}}; + Bin -> + put_chars(Bin, Port) + end; +io_request({put_chars,unicode,Mod,Func,Args}, Port) -> + case catch apply(Mod, Func, Args) of + Data when is_list(Data); is_binary(Data) -> + case wrap_characters_to_binary(Data, unicode, get(encoding)) of + Bin when is_binary(Bin) -> + put_chars(Bin, Port); + error -> + {error,{error,put_chars}} + end; + _ -> + {error,{error,put_chars}} + end; +io_request({put_chars,latin1,Chars}, Port) -> + case catch unicode:characters_to_binary(Chars, latin1, get(encoding)) of + Data when is_binary(Data) -> + put_chars(Data, Port); + _ -> + {error,{error,put_chars}} + end; +io_request({put_chars,latin1,Mod,Func,Args}, Port) -> + case catch apply(Mod, Func, Args) of + Data when is_list(Data); is_binary(Data) -> + case + catch unicode:characters_to_binary(Data, latin1, get(encoding)) + of + Bin when is_binary(Bin) -> + put_chars(Bin, Port); + _ -> + {error,{error,put_chars}} + end; + _ -> + {error,{error,put_chars}} + end; %% BC if called from pre-R13 node io_request({put_chars,Chars}, Port) -> io_request({put_chars,latin1,Chars}, Port); @@ -134,10 +156,10 @@ io_request({get_geometry,rows},Port) -> _ -> {error,{error,enotsup}} end; -io_request({getopts,[]}, Port) -> - getopts(Port); -io_request({setopts,Opts}, Port) when is_list(Opts) -> - setopts(Opts, Port); +io_request(getopts, _Port) -> + getopts(); +io_request({setopts,Opts}, _Port) when is_list(Opts) -> + setopts(Opts); io_request({requests,Reqs}, Port) -> io_requests(Reqs, {ok,ok}, Port); io_request(R, _Port) -> %Unknown request @@ -176,47 +198,48 @@ io_reply(From, ReplyAs, Reply) -> %% put_chars put_chars(Chars, Port) when is_binary(Chars) -> _ = put_port(Chars, Port), - {ok,ok}; -put_chars(Chars, Port) -> - case catch list_to_binary(Chars) of - Binary when is_binary(Binary) -> - put_chars(Binary, Port); - _ -> - {error,{error,put_chars}} - end. + {ok,ok}. %% setopts -setopts(Opts0,Port) -> - Opts = proplists:unfold( - proplists:substitute_negations( - [{latin1,unicode}], - Opts0)), +setopts(Opts0) -> + Opts = expand_encoding(Opts0), case check_valid_opts(Opts) of - true -> - do_setopts(Opts,Port); - false -> - {error,{error,enotsup}} + true -> + do_setopts(Opts); + false -> + {error,{error,enotsup}} end. + check_valid_opts([]) -> true; -check_valid_opts([{unicode,Valid}|T]) when Valid =:= true; Valid =:= utf8; Valid =:= false -> +check_valid_opts([{encoding,Valid}|T]) when Valid =:= unicode; + Valid =:= utf8; Valid =:= latin1 -> check_valid_opts(T); check_valid_opts(_) -> false. -do_setopts(Opts, _Port) -> - case proplists:get_value(unicode,Opts) of - Valid when Valid =:= true; Valid =:= utf8 -> - put(unicode,true); - false -> - put(unicode,false); - undefined -> - ok +expand_encoding([]) -> + []; +expand_encoding([latin1 | T]) -> + [{encoding,latin1} | expand_encoding(T)]; +expand_encoding([unicode | T]) -> + [{encoding,unicode} | expand_encoding(T)]; +expand_encoding([H|T]) -> + [H|expand_encoding(T)]. + +do_setopts(Opts) -> + case proplists:get_value(encoding, Opts) of + Valid when Valid =:= unicode; Valid =:= utf8 -> + put(encoding, unicode); + latin1 -> + put(encoding, latin1); + undefined -> + ok end, {ok,ok}. -getopts(_Port) -> - Uni = {unicode, get(unicode) =:= true}, +getopts() -> + Uni = {encoding,get(encoding)}, {ok,[Uni]}. wrap_characters_to_binary(Chars,From,To) -> @@ -227,17 +250,17 @@ wrap_characters_to_binary(Chars,From,To) -> _Else -> 16#10ffff end, - unicode:characters_to_binary( - [ case X of - $\n -> - if - TrNl -> - "\r\n"; - true -> - $\n - end; - High when High > Limit -> - ["\\x{",erlang:integer_to_list(X, 16),$}]; - Ordinary -> - Ordinary - end || X <- unicode:characters_to_list(Chars,From) ],unicode,To). + case catch unicode:characters_to_list(Chars, From) of + L when is_list(L) -> + unicode:characters_to_binary( + [ case X of + $\n when TrNl -> + "\r\n"; + High when High > Limit -> + ["\\x{",erlang:integer_to_list(X, 16),$}]; + Low -> + Low + end || X <- L ], unicode, To); + _ -> + error + end. diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile index f1b8a105ed..ef351a25fb 100644 --- a/lib/kernel/test/Makefile +++ b/lib/kernel/test/Makefile @@ -77,7 +77,8 @@ MODULES= \ ignore_cores \ zlib_SUITE \ loose_node \ - sendfile_SUITE + sendfile_SUITE \ + standard_error_SUITE APP_FILES = \ appinc.app \ diff --git a/lib/kernel/test/standard_error_SUITE.erl b/lib/kernel/test/standard_error_SUITE.erl new file mode 100644 index 0000000000..b290454b40 --- /dev/null +++ b/lib/kernel/test/standard_error_SUITE.erl @@ -0,0 +1,38 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(standard_error_SUITE). + +-export([all/0,suite/0]). +-export([badarg/1,getopts/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + [badarg,getopts]. + +badarg(Config) when is_list(Config) -> + {'EXIT',{badarg,_}} = (catch io:put_chars(standard_error, [oops])), + true = erlang:is_process_alive(whereis(standard_error)), + ok. + +getopts(Config) when is_list(Config) -> + [{encoding,latin1}] = io:getopts(standard_error), + ok. diff --git a/lib/parsetools/include/leexinc.hrl b/lib/parsetools/include/leexinc.hrl index 938aef58f9..2657fdcfaa 100644 --- a/lib/parsetools/include/leexinc.hrl +++ b/lib/parsetools/include/leexinc.hrl @@ -44,6 +44,8 @@ string(Ics0, L0, Tcs, Ts) -> %% Test for and remove the end token wrapper. Push back characters %% are prepended to RestChars. +-dialyzer({nowarn_function, string_cont/4}). + string_cont(Rest, Line, {token,T}, Ts) -> string(Rest, Line, Rest, [T|Ts]); string_cont(Rest, Line, {token,T,Push}, Ts) -> @@ -113,6 +115,8 @@ token(S0, Ics0, L0, Tcs, Tlen0, Tline, A0, Alen0) -> %% If we have a token or error then return done, else if we have a %% skip_token then continue. +-dialyzer({nowarn_function, token_cont/3}). + token_cont(Rest, Line, {token,T}) -> {done,{ok,T,Line},Rest}; token_cont(Rest, Line, {token,T,Push}) -> @@ -187,6 +191,8 @@ tokens(S0, Ics0, L0, Tcs, Tlen0, Tline, Ts, A0, Alen0) -> %% a token then save it and continue, else if we have a skip_token %% just continue. +-dialyzer({nowarn_function, tokens_cont/4}). + tokens_cont(Rest, Line, {token,T}, Ts) -> tokens(yystate(), Rest, Line, Rest, 0, Line, [T|Ts], reject, 0); tokens_cont(Rest, Line, {token,T,Push}, Ts) -> @@ -238,6 +244,8 @@ skip_tokens(S0, Ics0, L0, Tcs, Tlen0, Tline, Error, A0, Alen0) -> %% Skip tokens until we have an end_token or error then return done %% with the original rror. +-dialyzer({nowarn_function, skip_cont/4}). + skip_cont(Rest, Line, {token,_T}, Error) -> skip_tokens(yystate(), Rest, Line, Rest, 0, Line, Error, reject, 0); skip_cont(Rest, Line, {token,_T,Push}, Error) -> diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl index f4657663e6..3fcec73ce2 100644 --- a/lib/parsetools/src/yecc.erl +++ b/lib/parsetools/src/yecc.erl @@ -2064,11 +2064,13 @@ output_actions(St0, StateJumps, StateInfo) -> SelS = [{State,Called} || {{State,_JActions}, {State,Called}} <- lists:zip(StateJumps, lists:keysort(1, Sel))], + St05 = + fwrite(St0, <<"-dialyzer({nowarn_function, yeccpars2/7}).\n">>, []), St10 = foldl(fun({State, Called}, St_0) -> {State, #state_info{state_repr = IState}} = lookup_state(StateInfo, State), output_state_selection(St_0, State, IState, Called) - end, St0, SelS), + end, St05, SelS), St20 = fwrite(St10, <<"yeccpars2(Other, _, _, _, _, _, _) ->\n">>, []), St = fwrite(St20, ?YECC_BUG(<<"{missing_state_in_action_table, Other}">>, []), @@ -2089,7 +2091,8 @@ output_state_selection(St0, State, IState, Called) -> [Comment, IState]). output_state_actions(St, State, State, {Actions,jump_none}, SI) -> - output_state_actions1(St, State, Actions, true, normal, SI); + St1 = output_state_actions_begin(St, State, Actions), + output_state_actions1(St1, State, Actions, true, normal, SI); output_state_actions(St0, State, State, {Actions, Jump}, SI) -> {Tag, To, Common} = Jump, CS = case Tag of @@ -2099,13 +2102,22 @@ output_state_actions(St0, State, State, {Actions, Jump}, SI) -> St = output_state_actions1(St0, State, Actions, true, {to, CS}, SI), if To =:= State -> - output_state_actions1(St, CS, Common, true, normal, SI); + St1 = output_state_actions_begin(St, State, Actions), + output_state_actions1(St1, CS, Common, true, normal, SI); true -> St end; output_state_actions(St, State, JState, _XActions, _SI) -> fwrite(St, <<"%% yeccpars2_~w: see yeccpars2_~w\n\n">>, [State, JState]). +output_state_actions_begin(St, State, Actions) -> + case [yes || {_, #reduce{}} <- Actions] of + [] -> + fwrite(St, <<"-dialyzer({nowarn_function, yeccpars2_~w/7}).\n">>, + [State]); % Only when yeccerror(T) is output. + _ -> St + end. + output_state_actions1(St, State, [], IsFirst, normal, _SI) -> output_state_actions_fini(State, IsFirst, St); output_state_actions1(St0, State, [], IsFirst, {to, ToS}, _SI) -> diff --git a/lib/parsetools/test/yecc_SUITE.erl b/lib/parsetools/test/yecc_SUITE.erl index d308d21f82..c18dc15e37 100644 --- a/lib/parsetools/test/yecc_SUITE.erl +++ b/lib/parsetools/test/yecc_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2014. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -340,8 +340,8 @@ syntax(Config) when is_list(Config) -> {_,[{L1,_,{undefined_function,{yeccpars2_2_,1}}}, {L2,_,{bad_inline,{yeccpars2_2_,1}}}]}], []} = compile:file(Parserfile1, [basic_validation,return]), - ?line L1 = 28 + SzYeccPre, - ?line L2 = 35 + SzYeccPre + ?line L1 = 31 + SzYeccPre, + ?line L2 = 38 + SzYeccPre end(), %% Bad macro in action. OTP-7224. @@ -358,8 +358,8 @@ syntax(Config) when is_list(Config) -> {_,[{L1,_,{undefined_function,{yeccpars2_2_,1}}}, {L2,_,{bad_inline,{yeccpars2_2_,1}}}]}], []} = compile:file(Parserfile1, [basic_validation,return]), - ?line L1 = 28 + SzYeccPre, - ?line L2 = 35 + SzYeccPre + ?line L1 = 31 + SzYeccPre, + ?line L2 = 38 + SzYeccPre end(), %% Check line numbers. OTP-7224. @@ -1619,8 +1619,8 @@ otp_7292(Config) when is_list(Config) -> {L2,_,{bad_inline,{yeccpars2_2_,1}}}]}], [{_,[{16,_,{unused_function,{foo,0}}}]}]} = compile:file(Parserfile1, [basic_validation, return]), - ?line L1 = 38 + SzYeccPre, - ?line L2 = 45 + SzYeccPre + L1 = 41 + SzYeccPre, + L2 = 48 + SzYeccPre end(), YeccPre = filename:join(Dir, "yeccpre.hrl"), @@ -1637,8 +1637,8 @@ otp_7292(Config) when is_list(Config) -> {L2,_,{bad_inline,{yeccpars2_2_,1}}}]}], [{_,[{16,_,{unused_function,{foo,0}}}]}]} = compile:file(Parserfile1, [basic_validation, return]), - ?line L1 = 37 + SzYeccPre, - ?line L2 = 44 + SzYeccPre + ?line L1 = 40 + SzYeccPre, + ?line L2 = 47 + SzYeccPre end(), file:delete(YeccPre), diff --git a/lib/ssh/doc/src/using_ssh.xml b/lib/ssh/doc/src/using_ssh.xml index 9ab71260d3..46178d4018 100644 --- a/lib/ssh/doc/src/using_ssh.xml +++ b/lib/ssh/doc/src/using_ssh.xml @@ -79,7 +79,7 @@ <p> The option user_dir defaults to the users ~/.ssh directory</p> <p>In the following example we generate new keys and host keys as - to be able to run the example without having root privilages</p> + to be able to run the example without having root privileges</p> <code> $bash> ssh-keygen -t rsa -f /tmp/ssh_daemon/ssh_host_rsa_key diff --git a/lib/ssh/src/ssh_sftpd.erl b/lib/ssh/src/ssh_sftpd.erl index 52665635f0..04ae6b11e2 100644 --- a/lib/ssh/src/ssh_sftpd.erl +++ b/lib/ssh/src/ssh_sftpd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2013. All Rights Reserved. +%% Copyright Ericsson AB 2005-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -559,56 +559,73 @@ stat(ReqId, RelPath, State0=#state{file_handler=FileMod, send_status({error, E}, ReqId, State1) end. -decode_4_open_flag(create_new) -> - [write]; -decode_4_open_flag(create_truncate) -> - [write]; -decode_4_open_flag(truncate_existing) -> - [write]; -decode_4_open_flag(open_existing) -> - [read]. - -decode_4_flags([OpenFlag | Flags]) -> - decode_4_flags(Flags, decode_4_open_flag(OpenFlag)). - -decode_4_flags([], Flags) -> - Flags; -decode_4_flags([append_data|R], _Flags) -> - decode_4_flags(R, [append]); -decode_4_flags([append_data_atomic|R], _Flags) -> - decode_4_flags(R, [append]); -decode_4_flags([_|R], Flags) -> - decode_4_flags(R, Flags). - -decode_4_access_flag(read_data) -> - [read]; -decode_4_access_flag(list_directory) -> - [read]; -decode_4_access_flag(write_data) -> - [write]; -decode_4_access_flag(add_file) -> - [write]; -decode_4_access_flag(add_subdirectory) -> - [read]; -decode_4_access_flag(append_data) -> - [append]; -decode_4_access_flag(write_attributes) -> - [write]; -decode_4_access_flag(_) -> - [read]. - -decode_4_acess([_ | _] = Flags) -> +sftp_to_erlang_flag(read, Vsn) when Vsn == 3; + Vsn == 4 -> + read; +sftp_to_erlang_flag(write, Vsn) when Vsn == 3; + Vsn == 4 -> + write; +sftp_to_erlang_flag(append, Vsn) when Vsn == 3; + Vsn == 4 -> + append; +sftp_to_erlang_flag(creat, Vsn) when Vsn == 3; + Vsn == 4 -> + write; +sftp_to_erlang_flag(trunc, Vsn) when Vsn == 3; + Vsn == 4 -> + write; +sftp_to_erlang_flag(excl, Vsn) when Vsn == 3; + Vsn == 4 -> + read; +sftp_to_erlang_flag(create_new, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(create_truncate, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(open_existing, Vsn) when Vsn > 4 -> + read; +sftp_to_erlang_flag(open_or_create, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(truncate_existing, Vsn) when Vsn > 4 -> + write; +sftp_to_erlang_flag(append_data, Vsn) when Vsn > 4 -> + append; +sftp_to_erlang_flag(append_data_atomic, Vsn) when Vsn > 4 -> + append; +sftp_to_erlang_flag(_, _) -> + read. + +sftp_to_erlang_flags(Flags, Vsn) -> lists:map(fun(Flag) -> - [decode_4_access_flag(Flag)] - end, Flags); -decode_4_acess([]) -> - []. + sftp_to_erlang_flag(Flag, Vsn) + end, Flags). + +sftp_to_erlang_access_flag(read_data, _) -> + read; +sftp_to_erlang_access_flag(list_directory, _) -> + read; +sftp_to_erlang_access_flag(write_data, _) -> + write; +sftp_to_erlang_access_flag(append_data, _) -> + append; +sftp_to_erlang_access_flag(add_subdirectory, _) -> + read; +sftp_to_erlang_access_flag(add_file, _) -> + write; +sftp_to_erlang_access_flag(write_attributes, _) -> + write; +sftp_to_erlang_access_flag(_, _) -> + read. +sftp_to_erlang_access_flags(Flags, Vsn) -> + lists:map(fun(Flag) -> + sftp_to_erlang_access_flag(Flag, Vsn) + end, Flags). open(Vsn, ReqId, Data, State) when Vsn =< 3 -> <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(PFlags), _Attrs/binary>> = Data, Path = unicode:characters_to_list(BPath), - Flags = ssh_xfer:decode_open_flags(Vsn, PFlags), + FlagBits = ssh_xfer:decode_open_flags(Vsn, PFlags), + Flags = lists:usort(sftp_to_erlang_flags(FlagBits, Vsn)), do_open(ReqId, State, Path, Flags); open(Vsn, ReqId, Data, State) when Vsn >= 4 -> <<?UINT32(BLen), BPath:BLen/binary, ?UINT32(Access), @@ -616,15 +633,12 @@ open(Vsn, ReqId, Data, State) when Vsn >= 4 -> Path = unicode:characters_to_list(BPath), FlagBits = ssh_xfer:decode_open_flags(Vsn, PFlags), AcessBits = ssh_xfer:decode_ace_mask(Access), - %% TODO: This is to make sure the Access flags are not ignored - %% but this should be thought through better. This solution should - %% be considered a hack in order to buy some time. At least - %% it works better than when the Access flags where totally ignored. - %% A better solution may need some code refactoring that we do - %% not have time for right now. - AcessFlags = decode_4_acess(AcessBits), - Flags = lists:append(lists:umerge( - [[decode_4_flags(FlagBits)] | AcessFlags])), + %% TODO: There are still flags that are not + %% fully handled as SSH_FXF_ACCESS_TEXT_MODE and + %% a lot a ACE flags, the later we may not need + %% to understand as they are NFS flags + AcessFlags = sftp_to_erlang_access_flags(AcessBits, Vsn), + Flags = lists:usort(sftp_to_erlang_flags(FlagBits, Vsn) ++ AcessFlags), do_open(ReqId, State, Path, Flags). do_open(ReqId, State0, Path, Flags) -> diff --git a/lib/ssh/test/ssh_sftpd_SUITE.erl b/lib/ssh/test/ssh_sftpd_SUITE.erl index 7b22e45d5e..0ce8eec906 100644 --- a/lib/ssh/test/ssh_sftpd_SUITE.erl +++ b/lib/ssh/test/ssh_sftpd_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -56,7 +56,8 @@ all() -> retrieve_attributes, set_attributes, links, - ver3_rename, + ver3_rename, + ver3_open_flags, relpath, sshd_read_file, ver6_basic]. @@ -193,6 +194,39 @@ open_close_file(Config) when is_list(Config) -> ?ACE4_READ_DATA bor ?ACE4_READ_ATTRIBUTES, ?SSH_FXF_OPEN_EXISTING). +ver3_open_flags() -> + [{doc, "Test open flags"}]. +ver3_open_flags(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + FileName = filename:join(PrivDir, "not_exist.txt"), + {Cm, Channel} = ?config(sftp, Config), + ReqId = 0, + + {ok, <<?SSH_FXP_HANDLE, ?UINT32(ReqId), Handle/binary>>, _} = + open_file_v3(FileName, Cm, Channel, ReqId, + ?SSH_FXF_CREAT bor ?SSH_FXF_TRUNC), + {ok, <<?SSH_FXP_STATUS, ?UINT32(ReqId), + ?UINT32(?SSH_FX_OK), _/binary>>, _} = close(Handle, ReqId, + Cm, Channel), + + NewFileName = filename:join(PrivDir, "not_exist2.txt"), + NewReqId = ReqId + 1, + {ok, <<?SSH_FXP_HANDLE, ?UINT32(NewReqId), NewHandle/binary>>, _} = + open_file_v3(NewFileName, Cm, Channel, NewReqId, + ?SSH_FXF_CREAT bor ?SSH_FXF_EXCL), + {ok, <<?SSH_FXP_STATUS, ?UINT32(NewReqId), + ?UINT32(?SSH_FX_OK), _/binary>>, _} = close(NewHandle, NewReqId, + Cm, Channel), + + NewFileName1 = filename:join(PrivDir, "test.txt"), + NewReqId1 = NewReqId + 1, + {ok, <<?SSH_FXP_HANDLE, ?UINT32(NewReqId1), NewHandle1/binary>>, _} = + open_file_v3(NewFileName1, Cm, Channel, NewReqId1, + ?SSH_FXF_READ bor ?SSH_FXF_WRITE bor ?SSH_FXF_APPEND), + {ok, <<?SSH_FXP_STATUS, ?UINT32(NewReqId1), + ?UINT32(?SSH_FX_OK), _/binary>>, _} = close(NewHandle1, NewReqId1, + Cm, Channel). + %%-------------------------------------------------------------------- open_close_dir() -> [{doc,"Test SSH_FXP_OPENDIR and SSH_FXP_CLOSE commands"}]. @@ -662,6 +696,16 @@ open_file(File, Cm, Channel, ReqId, Access, Flags) -> ?SSH_FXP_OPEN, Data/binary>>), reply(Cm, Channel). +open_file_v3(File, Cm, Channel, ReqId, Flags) -> + + Data = list_to_binary([?uint32(ReqId), + ?binary(list_to_binary(File)), + ?uint32(Flags), + ?REG_ATTERS]), + Size = 1 + size(Data), + ssh_connection:send(Cm, Channel, <<?UINT32(Size), + ?SSH_FXP_OPEN, Data/binary>>), + reply(Cm, Channel). close(Handle, ReqId, Cm , Channel) -> diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index 83e5ed82bb..d77c6440b0 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2014</year> + <year>1999</year><year>2015</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -38,7 +38,9 @@ <item>ssl requires the crypto and public_key applications.</item> <item>Supported SSL/TLS-versions are SSL-3.0, TLS-1.0, TLS-1.1 and TLS-1.2.</item> - <item>For security reasons sslv2 is not supported.</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 may be configured.</item> <item>Ephemeral Diffie-Hellman cipher suites are supported but not Diffie Hellman Certificates cipher suites.</item> <item>Elliptic Curve cipher suites are supported if crypto @@ -302,7 +304,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revo </item> - <tag>{partial_chain, fun(Chain::[DerCert]) -> {trusted_ca, DerCert} | unknown_ca </tag> + <tag>{partial_chain, fun(Chain::[DerCert]) -> {trusted_ca, DerCert} | unknown_ca }</tag> <item> Claim an intermediat CA in the chain as trusted. TLS will then perform the public_key:pkix_path_validation/3 with the selected CA as trusted anchor and the rest of the chain. @@ -311,7 +313,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom() | {revo <tag>{versions, [protocol()]}</tag> <item>TLS protocol versions that will be 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 to all versions supported by the SSL application. See also + 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> </item> @@ -348,11 +350,23 @@ fun(srp, Username :: string(), UserState :: term()) -> </p> </item> + <tag>{padding_check, boolean()}</tag> + <item> + <p> This option only affects TLS-1.0 connections. + If set to false it disables the block cipher padding check + to be able to interoperate with legacy software. + </p> + + <warning><p> Using this option makes TLS vulnerable to + the Poodle attack</p></warning> + + </item> + </taglist> - + </section> - - <section> + + <section> <title>SSL OPTION DESCRIPTIONS - CLIENT SIDE</title> <p>Options described here are client specific or has a slightly different @@ -904,19 +918,37 @@ fun(srp, Username :: string(), UserState :: term()) -> </func> <func> - <name>versions() -> - [{SslAppVer, SupportedSslVer, AvailableSslVsn}]</name> + <name>versions() -> [versions_info()]</name> <fsummary>Returns version information relevant for the ssl application.</fsummary> <type> - <v>SslAppVer = string()</v> - <v>SupportedSslVer = [protocol()]</v> - <v>AvailableSslVsn = [protocol()]</v> + <v>versions_info() = {app_vsn, string()} | {supported | available, [protocol()] </v> </type> <desc> <p> Returns version information relevant for the - ssl application.</p> + ssl application. + </p> + <taglist> + <tag>app_vsn</tag> + <item> The application version of the OTP ssl application.</item> + + <tag>supported</tag> + + <item>TLS/SSL versions supported by default. + Overridden by a versions 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 + marker="#connection_info-1">ssl:connection_info/1 + </seealso></item> + + <tag>available</tag> + <item>All TLS/SSL versions that the Erlang ssl application + can support. Note that TLS 1.2 requires sufficient support + from the crypto application. </item> + </taglist> </desc> </func> <func> diff --git a/lib/ssl/src/dtls_record.erl b/lib/ssl/src/dtls_record.erl index c0776e822b..59b3ddec5c 100644 --- a/lib/ssl/src/dtls_record.erl +++ b/lib/ssl/src/dtls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -194,7 +194,7 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, compression_algorithm=CompAlg} } = ReadState0}= ConnnectionStates0) -> {PlainFragment, Mac, ReadState1} = ssl_record:decipher(dtls_v1:corresponding_tls_version(Version), - CipherFragment, ReadState0), + CipherFragment, ReadState0, true), MacHash = calc_mac_hash(ReadState1, Type, Version, Epoch, Seq, PlainFragment), case ssl_record:is_correct_mac(Mac, MacHash) of true -> diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index dcba69a65e..ab26b6abc4 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2014. All Rights Reserved. +%% Copyright Ericsson AB 1999-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -353,12 +353,8 @@ cipher_suites(openssl) -> || S <- ssl_cipher:filter_suites(ssl_cipher:suites(Version))]; cipher_suites(all) -> Version = tls_record:highest_protocol_version([]), - Supported = ssl_cipher:all_suites(Version) - ++ ssl_cipher:anonymous_suites(Version) - ++ ssl_cipher:psk_suites(Version) - ++ ssl_cipher:srp_suites(), - ssl_cipher:filter_suites([suite_definition(S) || S <- Supported]). - + ssl_cipher:filter_suites([suite_definition(S) + || S <-ssl_cipher:all_suites(Version)]). cipher_suites() -> cipher_suites(erlang). @@ -454,7 +450,7 @@ session_info(#sslsocket{pid = {Listen,_}}) when is_port(Listen) -> versions() -> Vsns = tls_record:supported_protocol_versions(), SupportedVsns = [tls_record:protocol_version(Vsn) || Vsn <- Vsns], - AvailableVsns = ?ALL_SUPPORTED_VERSIONS, + AvailableVsns = ?ALL_AVAILABLE_VERSIONS, %% TODO Add DTLS versions when supported [{ssl_app, ?VSN}, {supported, SupportedVsns}, {available, AvailableVsns}]. @@ -656,7 +652,8 @@ handle_options(Opts0) -> log_alert = handle_option(log_alert, Opts, true), server_name_indication = handle_option(server_name_indication, Opts, undefined), honor_cipher_order = handle_option(honor_cipher_order, Opts, false), - protocol = proplists:get_value(protocol, Opts, tls) + protocol = proplists:get_value(protocol, Opts, tls), + padding_check = proplists:get_value(padding_check, Opts, true) }, CbInfo = proplists:get_value(cb_info, Opts, {gen_tcp, tcp, tcp_closed, tcp_error}), @@ -669,7 +666,7 @@ handle_options(Opts0) -> cb_info, renegotiate_at, secure_renegotiate, hibernate_after, erl_dist, next_protocols_advertised, client_preferred_next_protocols, log_alert, - server_name_indication, honor_cipher_order], + server_name_indication, honor_cipher_order, padding_check], SockOpts = lists:foldl(fun(Key, PropList) -> proplists:delete(Key, PropList) @@ -847,6 +844,8 @@ validate_option(server_name_indication, undefined) -> undefined; validate_option(honor_cipher_order, Value) when is_boolean(Value) -> Value; +validate_option(padding_check, Value) when is_boolean(Value) -> + Value; validate_option(Opt, Value) -> throw({error, {options, {Opt, Value}}}). @@ -952,10 +951,7 @@ binary_cipher_suites(Version, [{_,_,_}| _] = Ciphers0) -> binary_cipher_suites(Version, Ciphers); binary_cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) -> - All = ssl_cipher:suites(Version) - ++ ssl_cipher:anonymous_suites(Version) - ++ ssl_cipher:psk_suites(Version) - ++ ssl_cipher:srp_suites(), + All = ssl_cipher:all_suites(Version), case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, All)] of [] -> %% Defaults to all supported suites that does @@ -1182,3 +1178,4 @@ handle_verify_options(Opts, CaCerts) -> Value -> throw({error, {options, {verify, Value}}}) end. + diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl index e1d89c149e..5ec6e1c31b 100644 --- a/lib/ssl/src/ssl_cipher.erl +++ b/lib/ssl/src/ssl_cipher.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -33,10 +33,10 @@ -include_lib("public_key/include/public_key.hrl"). -export([security_parameters/2, security_parameters/3, suite_definition/1, - cipher_init/3, decipher/5, cipher/5, decipher_aead/6, cipher_aead/6, + 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, - openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, + rc4_suites/1, openssl_suite/1, openssl_suite_name/1, filter/2, filter_suites/1, hash_algorithm/1, sign_algorithm/1, is_acceptable_hash/2]). -export_type([cipher_suite/0, @@ -182,7 +182,8 @@ block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, {T, CS0#cipher_state{iv=NextIV}}. %%-------------------------------------------------------------------- --spec decipher(cipher_enum(), integer(), #cipher_state{}, binary(), ssl_record:ssl_version()) -> +-spec decipher(cipher_enum(), integer(), #cipher_state{}, binary(), + ssl_record:ssl_version(), boolean()) -> {binary(), binary(), #cipher_state{}} | #alert{}. %% %% Description: Decrypts the data and the MAC using cipher described @@ -190,9 +191,9 @@ block_cipher(Fun, BlockSz, #cipher_state{key=Key, iv=IV} = CS0, %% Used for "MAC then Cipher" suites where first the data is decrypted %% and the an HMAC of the decrypted data is checked %%------------------------------------------------------------------- -decipher(?NULL, _HashSz, CipherState, Fragment, _) -> +decipher(?NULL, _HashSz, CipherState, Fragment, _, _) -> {Fragment, <<>>, CipherState}; -decipher(?RC4, HashSz, CipherState = #cipher_state{state = State0}, Fragment, _) -> +decipher(?RC4, HashSz, CipherState = #cipher_state{state = State0}, Fragment, _, _) -> try crypto:stream_decrypt(State0, Fragment) of {State, Text} -> GSC = generic_stream_cipher_from_bin(Text, HashSz), @@ -208,20 +209,20 @@ decipher(?RC4, HashSz, CipherState = #cipher_state{state = State0}, Fragment, _) ?ALERT_REC(?FATAL, ?BAD_RECORD_MAC) end; -decipher(?DES, HashSz, CipherState, Fragment, Version) -> +decipher(?DES, HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(Key, IV, T) -> crypto:block_decrypt(des_cbc, Key, IV, T) - end, CipherState, HashSz, Fragment, Version); -decipher(?'3DES', HashSz, CipherState, Fragment, Version) -> + end, CipherState, HashSz, Fragment, Version, PaddingCheck); +decipher(?'3DES', HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(<<K1:8/binary, K2:8/binary, K3:8/binary>>, IV, T) -> crypto:block_decrypt(des3_cbc, [K1, K2, K3], IV, T) - end, CipherState, HashSz, Fragment, Version); -decipher(?AES_CBC, HashSz, CipherState, Fragment, Version) -> + end, CipherState, HashSz, Fragment, Version, PaddingCheck); +decipher(?AES_CBC, HashSz, CipherState, Fragment, Version, PaddingCheck) -> block_decipher(fun(Key, IV, T) when byte_size(Key) =:= 16 -> crypto:block_decrypt(aes_cbc128, Key, IV, T); (Key, IV, T) when byte_size(Key) =:= 32 -> crypto:block_decrypt(aes_cbc256, Key, IV, T) - end, CipherState, HashSz, Fragment, Version). + end, CipherState, HashSz, Fragment, Version, PaddingCheck). %%-------------------------------------------------------------------- -spec decipher_aead(cipher_enum(), #cipher_state{}, integer(), binary(), binary(), ssl_record:ssl_version()) -> @@ -237,7 +238,7 @@ decipher_aead(?CHACHA20_POLY1305, CipherState, SeqNo, AAD, Fragment, Version) -> aead_decipher(chacha20_poly1305, CipherState, SeqNo, AAD, Fragment, Version). block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, - HashSz, Fragment, Version) -> + HashSz, Fragment, Version, PaddingCheck) -> try Text = Fun(Key, IV, Fragment), NextIV = next_iv(Fragment, IV), @@ -245,7 +246,7 @@ block_decipher(Fun, #cipher_state{key=Key, iv=IV} = CipherState0, Content = GBC#generic_block_cipher.content, Mac = GBC#generic_block_cipher.mac, CipherState1 = CipherState0#cipher_state{iv=GBC#generic_block_cipher.next_iv}, - case is_correct_padding(GBC, Version) of + case is_correct_padding(GBC, Version, PaddingCheck) of true -> {Content, Mac, CipherState1}; false -> @@ -306,9 +307,10 @@ suites({3, N}) -> all_suites(Version) -> suites(Version) - ++ ssl_cipher:anonymous_suites(Version) - ++ ssl_cipher:psk_suites(Version) - ++ ssl_cipher:srp_suites(). + ++ anonymous_suites(Version) + ++ psk_suites(Version) + ++ srp_suites() + ++ rc4_suites(Version). %%-------------------------------------------------------------------- -spec anonymous_suites(ssl_record:ssl_version() | integer()) -> [cipher_suite()]. %% @@ -394,6 +396,24 @@ srp_suites() -> ?TLS_SRP_SHA_WITH_AES_256_CBC_SHA, ?TLS_SRP_SHA_RSA_WITH_AES_256_CBC_SHA, ?TLS_SRP_SHA_DSS_WITH_AES_256_CBC_SHA]. +%%-------------------------------------------------------------------- +-spec rc4_suites(Version::ssl_record:ssl_version()) -> [cipher_suite()]. +%% +%% Description: Returns a list of the RSA|(ECDH/RSA)| (ECDH/ECDSA) +%% with RC4 cipher suites, only supported if explicitly set by user. +%% Are not considered secure any more. Other RC4 suites already +%% belonged to the user configured only category. +%%-------------------------------------------------------------------- +rc4_suites({3, 0}) -> + [?TLS_RSA_WITH_RC4_128_SHA, + ?TLS_RSA_WITH_RC4_128_MD5]; +rc4_suites({3, N}) when N =< 3 -> + [?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA, + ?TLS_ECDHE_RSA_WITH_RC4_128_SHA, + ?TLS_RSA_WITH_RC4_128_SHA, + ?TLS_RSA_WITH_RC4_128_MD5, + ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA, + ?TLS_ECDH_RSA_WITH_RC4_128_SHA]. %%-------------------------------------------------------------------- -spec suite_definition(cipher_suite()) -> int_cipher_suite(). @@ -1632,16 +1652,18 @@ generic_stream_cipher_from_bin(T, HashSz) -> #generic_stream_cipher{content=Content, mac=Mac}. -%% For interoperability reasons we do not check the padding content in -%% SSL 3.0 and TLS 1.0 as it is not strictly required and breaks -%% interopability with for instance Google. is_correct_padding(#generic_block_cipher{padding_length = Len, - padding = Padding}, {3, N}) - when N == 0; N == 1 -> - Len == byte_size(Padding); -%% Padding must be check in TLS 1.1 and after + padding = Padding}, {3, 0}, _) -> + Len == byte_size(Padding); %% Only length check is done in SSL 3.0 spec +%% For interoperability reasons it is possible to disable +%% the padding check when using TLS 1.0, as it is not strictly required +%% in the spec (only recommended), howerver this makes TLS 1.0 vunrable to the Poodle attack +%% so by default this clause will not match +is_correct_padding(GenBlockCipher, {3, 1}, false) -> + is_correct_padding(GenBlockCipher, {3, 0}, false); +%% Padding must be checked in TLS 1.1 and after is_correct_padding(#generic_block_cipher{padding_length = Len, - padding = Padding}, _) -> + padding = Padding}, _, _) -> Len == byte_size(Padding) andalso list_to_binary(lists:duplicate(Len, Len)) == Padding. diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl index 75efb64e3f..3cf6020169 100644 --- a/lib/ssl/src/ssl_internal.hrl +++ b/lib/ssl/src/ssl_internal.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -67,8 +67,11 @@ -define(TRUE, 0). -define(FALSE, 1). --define(ALL_SUPPORTED_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1, sslv3]). --define(MIN_SUPPORTED_VERSIONS, ['tlsv1.1', tlsv1, sslv3]). +%% 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_SUPPORTED_VERSIONS, ['tlsv1.2', 'tlsv1.1', tlsv1]). +-define(MIN_SUPPORTED_VERSIONS, ['tlsv1.1', tlsv1]). -define(ALL_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]). -define(MIN_DATAGRAM_SUPPORTED_VERSIONS, ['dtlsv1.2', dtlsv1]). @@ -117,7 +120,8 @@ server_name_indication = undefined, %% Should the server prefer its own cipher order over the one provided by %% the client? - honor_cipher_order = false + honor_cipher_order = false, + padding_check = true }). -record(socket_options, diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 63fc57edad..a02375a947 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2013-2014. All Rights Reserved. +%% Copyright Ericsson AB 2013-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -48,7 +48,7 @@ -export([compress/3, uncompress/3, compressions/0]). %% Payload encryption/decryption --export([cipher/4, decipher/3, is_correct_mac/2, +-export([cipher/4, decipher/4, is_correct_mac/2, cipher_aead/4, decipher_aead/4]). -export_type([ssl_version/0, ssl_atom_version/0]). @@ -396,7 +396,7 @@ cipher_aead(Version, Fragment, {CipherFragment, WriteState0#connection_state{cipher_state = CipherS1}}. %%-------------------------------------------------------------------- --spec decipher(ssl_version(), binary(), #connection_state{}) -> {binary(), binary(), #connection_state{}} | #alert{}. +-spec decipher(ssl_version(), binary(), #connection_state{}, boolean()) -> {binary(), binary(), #connection_state{}} | #alert{}. %% %% Description: Payload decryption %%-------------------------------------------------------------------- @@ -406,8 +406,8 @@ decipher(Version, CipherFragment, BulkCipherAlgo, hash_size = HashSz}, cipher_state = CipherS0 - } = ReadState) -> - case ssl_cipher:decipher(BulkCipherAlgo, HashSz, CipherS0, CipherFragment, Version) of + } = ReadState, PaddingCheck) -> + case ssl_cipher:decipher(BulkCipherAlgo, HashSz, CipherS0, CipherFragment, Version, PaddingCheck) of {PlainFragment, Mac, CipherS1} -> CS1 = ReadState#connection_state{cipher_state = CipherS1}, {PlainFragment, Mac, CS1}; diff --git a/lib/ssl/src/ssl_v3.erl b/lib/ssl/src/ssl_v3.erl index 68f7f5dee2..169b39be32 100644 --- a/lib/ssl/src/ssl_v3.erl +++ b/lib/ssl/src/ssl_v3.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -143,9 +143,6 @@ suites() -> ?TLS_DHE_RSA_WITH_AES_128_CBC_SHA, ?TLS_DHE_DSS_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_AES_128_CBC_SHA, - %%?TLS_RSA_WITH_IDEA_CBC_SHA, - ?TLS_RSA_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_RC4_128_MD5, ?TLS_RSA_WITH_DES_CBC_SHA ]. diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index 7df73fb581..77d3aa7889 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -482,8 +482,9 @@ next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_ci next_record(#state{protocol_buffers = #protocol_buffers{tls_packets = [], tls_cipher_texts = [CT | Rest]} = Buffers, - connection_states = ConnStates0} = State) -> - case tls_record:decode_cipher_text(CT, ConnStates0) of + connection_states = ConnStates0, + ssl_options = #ssl_options{padding_check = Check}} = State) -> + case tls_record:decode_cipher_text(CT, ConnStates0, Check) of {Plain, ConnStates} -> {Plain, State#state{protocol_buffers = Buffers#protocol_buffers{tls_cipher_texts = Rest}, diff --git a/lib/ssl/src/tls_record.erl b/lib/ssl/src/tls_record.erl index 544d200f70..3d5c5c0da3 100644 --- a/lib/ssl/src/tls_record.erl +++ b/lib/ssl/src/tls_record.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -34,7 +34,7 @@ -export([get_tls_records/2]). %% Decoding --export([decode_cipher_text/2]). +-export([decode_cipher_text/3]). %% Encoding -export([encode_plain_text/4]). @@ -159,7 +159,7 @@ encode_plain_text(Type, Version, Data, {CipherText, ConnectionStates#connection_states{current_write = WriteState#connection_state{sequence_number = Seq +1}}}. %%-------------------------------------------------------------------- --spec decode_cipher_text(#ssl_tls{}, #connection_states{}) -> +-spec decode_cipher_text(#ssl_tls{}, #connection_states{}, boolean()) -> {#ssl_tls{}, #connection_states{}}| #alert{}. %% %% Description: Decode cipher text @@ -174,7 +174,7 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, #security_parameters{ cipher_type = ?AEAD, compression_algorithm=CompAlg} - } = ReadState0} = ConnnectionStates0) -> + } = ReadState0} = ConnnectionStates0, _) -> AAD = calc_aad(Type, Version, ReadState0), case ssl_record:decipher_aead(Version, CipherFragment, ReadState0, AAD) of {PlainFragment, ReadState1} -> @@ -197,8 +197,8 @@ decode_cipher_text(#ssl_tls{type = Type, version = Version, sequence_number = Seq, security_parameters= #security_parameters{compression_algorithm=CompAlg} - } = ReadState0} = ConnnectionStates0) -> - case ssl_record:decipher(Version, CipherFragment, ReadState0) of + } = ReadState0} = ConnnectionStates0, PaddingCheck) -> + case ssl_record:decipher(Version, CipherFragment, ReadState0, PaddingCheck) of {PlainFragment, Mac, ReadState1} -> MacHash = calc_mac_hash(Type, Version, PlainFragment, ReadState1), case ssl_record:is_correct_mac(Mac, MacHash) of @@ -311,8 +311,17 @@ supported_protocol_versions([]) -> Vsns; supported_protocol_versions([_|_] = Vsns) -> - Vsns. - + case sufficient_tlsv1_2_crypto_support() of + true -> + Vsns; + false -> + case Vsns -- ['tlsv1.2'] of + [] -> + ?MIN_SUPPORTED_VERSIONS; + NewVsns -> + NewVsns + end + end. %%-------------------------------------------------------------------- %% %% Description: ssl version 2 is not acceptable security risks are too big. diff --git a/lib/ssl/src/tls_v1.erl b/lib/ssl/src/tls_v1.erl index c4114278a4..559fc1d6a8 100644 --- a/lib/ssl/src/tls_v1.erl +++ b/lib/ssl/src/tls_v1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -208,15 +208,7 @@ suites(Minor) when Minor == 1; Minor == 2 -> ?TLS_ECDH_ECDSA_WITH_AES_128_CBC_SHA, ?TLS_ECDH_RSA_WITH_AES_128_CBC_SHA, ?TLS_RSA_WITH_AES_128_CBC_SHA, - - ?TLS_ECDHE_ECDSA_WITH_RC4_128_SHA, - ?TLS_ECDHE_RSA_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_RC4_128_MD5, ?TLS_DHE_RSA_WITH_DES_CBC_SHA, - ?TLS_ECDH_ECDSA_WITH_RC4_128_SHA, - ?TLS_ECDH_RSA_WITH_RC4_128_SHA, - ?TLS_RSA_WITH_DES_CBC_SHA ]; suites(3) -> diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl index dc9e8934e6..723562c459 100644 --- a/lib/ssl/test/ssl_basic_SUITE.erl +++ b/lib/ssl/test/ssl_basic_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2014. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -65,7 +65,7 @@ groups() -> {'tlsv1.2', [], all_versions_groups()}, {'tlsv1.1', [], all_versions_groups()}, {'tlsv1', [], all_versions_groups() ++ rizzo_tests()}, - {'sslv3', [], all_versions_groups() ++ rizzo_tests()}, + {'sslv3', [], all_versions_groups() ++ rizzo_tests() ++ [ciphersuite_vs_version]}, {api,[], api_tests()}, {session, [], session_tests()}, {renegotiate, [], renegotiate_tests()}, @@ -90,7 +90,8 @@ basic_tests() -> version_option, connect_twice, connect_dist, - clear_pem_cache + clear_pem_cache, + defaults ]. options_tests() -> @@ -116,7 +117,6 @@ options_tests() -> tcp_reuseaddr, honor_server_cipher_order, honor_client_cipher_order, - ciphersuite_vs_version, unordered_protocol_versions_server, unordered_protocol_versions_client ]. @@ -177,6 +177,9 @@ cipher_tests() -> srp_cipher_suites, srp_anon_cipher_suites, srp_dsa_cipher_suites, + rc4_rsa_cipher_suites, + rc4_ecdh_rsa_cipher_suites, + rc4_ecdsa_cipher_suites, default_reject_anonymous]. cipher_tests_ec() -> @@ -343,7 +346,7 @@ alerts(Config) when is_list(Config) -> end, Alerts). %%-------------------------------------------------------------------- new_options_in_accept() -> - [{doc,"Test that you can set ssl options in ssl_accept/3 and not tcp upgrade"}]. + [{doc,"Test that you can set ssl options in ssl_accept/3 and not only in tcp upgrade"}]. new_options_in_accept(Config) when is_list(Config) -> ClientOpts = ?config(client_opts, Config), ServerOpts0 = ?config(server_dsa_opts, Config), @@ -361,7 +364,9 @@ new_options_in_accept(Config) when is_list(Config) -> {host, Hostname}, {from, self()}, {mfa, {?MODULE, connection_info_result, []}}, - {options, [{versions, [sslv3]} | ClientOpts]}]), + {options, [{versions, [sslv3]}, + {ciphers,[{rsa,rc4_128,sha} + ]} | ClientOpts]}]), ct:log("Testcase ~p, Client ~p Server ~p ~n", [self(), Client, Server]), @@ -391,7 +396,7 @@ connection_info(Config) when is_list(Config) -> {from, self()}, {mfa, {?MODULE, connection_info_result, []}}, {options, - [{ciphers,[{rsa,rc4_128,sha,no_export}]} | + [{ciphers,[{rsa,des_cbc,sha,no_export}]} | ClientOpts]}]), ct:log("Testcase ~p, Client ~p Server ~p ~n", @@ -400,7 +405,7 @@ connection_info(Config) when is_list(Config) -> Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), - ServerMsg = ClientMsg = {ok, {Version, {rsa,rc4_128,sha}}}, + ServerMsg = ClientMsg = {ok, {Version, {rsa, des_cbc, sha}}}, ssl_test_lib:check_result(Server, ServerMsg, Client, ClientMsg), @@ -1779,6 +1784,32 @@ srp_dsa_cipher_suites(Config) when is_list(Config) -> Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Ciphers = ssl_test_lib:srp_dss_suites(), run_suites(Ciphers, Version, Config, srp_dsa). +%%------------------------------------------------------------------- +rc4_rsa_cipher_suites()-> + [{doc, "Test the RC4 ciphersuites"}]. +rc4_rsa_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), + Version = tls_record:protocol_version(NVersion), + Ciphers = ssl_test_lib:rc4_suites(NVersion), + run_suites(Ciphers, Version, Config, rc4_rsa). +%------------------------------------------------------------------- +rc4_ecdh_rsa_cipher_suites()-> + [{doc, "Test the RC4 ciphersuites"}]. +rc4_ecdh_rsa_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), + Version = tls_record:protocol_version(NVersion), + Ciphers = ssl_test_lib:rc4_suites(NVersion), + run_suites(Ciphers, Version, Config, rc4_ecdh_rsa). + +%%------------------------------------------------------------------- +rc4_ecdsa_cipher_suites()-> + [{doc, "Test the RC4 ciphersuites"}]. +rc4_ecdsa_cipher_suites(Config) when is_list(Config) -> + NVersion = tls_record:highest_protocol_version([]), + Version = tls_record:protocol_version(NVersion), + Ciphers = ssl_test_lib:rc4_suites(NVersion), + run_suites(Ciphers, Version, Config, rc4_ecdsa). + %%-------------------------------------------------------------------- default_reject_anonymous()-> [{doc,"Test that by default anonymous cipher suites are rejected "}]. @@ -2507,6 +2538,16 @@ no_reuses_session_server_restart_new_cert_file(Config) when is_list(Config) -> ssl_test_lib:close(Client1). %%-------------------------------------------------------------------- +defaults(Config) when is_list(Config)-> + [_, + {supported, Supported}, + {available, Available}] + = ssl:versions(), + true = lists:member(sslv3, Available), + false = lists:member(sslv3, Supported), + false = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites()), + true = lists:member({rsa,rc4_128,sha}, ssl:cipher_suites(all)). +%%-------------------------------------------------------------------- reuseaddr() -> [{doc,"Test reuseaddr option"}]. @@ -2631,6 +2672,8 @@ honor_cipher_order(Config, Honor, ServerCiphers, ClientCiphers, Expected) -> ssl_test_lib:close(Client). %%-------------------------------------------------------------------- +ciphersuite_vs_version() -> + [{doc,"Test a SSLv3 client can not negotiate a TLSv* cipher suite."}]. ciphersuite_vs_version(Config) when is_list(Config) -> {_ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), @@ -3694,8 +3737,20 @@ run_suites(Ciphers, Version, Config, Type) -> ?config(server_ecdsa_opts, Config)}; ecdh_rsa -> {?config(client_opts, Config), - ?config(server_ecdh_rsa_opts, Config)} - end, + ?config(server_ecdh_rsa_opts, Config)}; + rc4_rsa -> + {?config(client_opts, Config), + [{ciphers, Ciphers} | + ?config(server_opts, Config)]}; + rc4_ecdh_rsa -> + {?config(client_opts, Config), + [{ciphers, Ciphers} | + ?config(server_ecdh_rsa_opts, Config)]}; + rc4_ecdsa -> + {?config(client_opts, Config), + [{ciphers, Ciphers} | + ?config(server_ecdsa_opts, Config)]} + end, Result = lists:map(fun(Cipher) -> cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end, @@ -3716,6 +3771,7 @@ erlang_cipher_suite(Suite) -> cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) -> %% process_flag(trap_exit, true), ct:log("Testing CipherSuite ~p~n", [CipherSuite]), + ct:log("Server Opts ~p~n", [ServerOpts]), {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), ErlangCipherSuite = erlang_cipher_suite(CipherSuite), diff --git a/lib/ssl/test/ssl_cipher_SUITE.erl b/lib/ssl/test/ssl_cipher_SUITE.erl index f2dc1b52c1..3433f9a445 100644 --- a/lib/ssl/test/ssl_cipher_SUITE.erl +++ b/lib/ssl/test/ssl_cipher_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -38,7 +38,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [aes_decipher_good, aes_decipher_good_tls11, aes_decipher_fail, aes_decipher_fail_tls11]. + [aes_decipher_good, aes_decipher_fail, padding_test]. groups() -> []. @@ -73,93 +73,122 @@ end_per_testcase(_TestCase, Config) -> %% Test Cases -------------------------------------------------------- %%-------------------------------------------------------------------- aes_decipher_good() -> - [{doc,"Decipher a known cryptotext."}]. + [{doc,"Decipher a known cryptotext using a correct key"}]. aes_decipher_good(Config) when is_list(Config) -> HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Content = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56, "HELLO\n">>, - Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, - Version = {3,0}, - {Content, Mac, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version), - Version1 = {3,1}, - {Content, Mac, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1), - ok. + CipherState = correct_cipher_state(), + decipher_check_good(HashSz, CipherState, {3,0}), + decipher_check_good(HashSz, CipherState, {3,1}), + decipher_check_good(HashSz, CipherState, {3,2}), + decipher_check_good(HashSz, CipherState, {3,3}). %%-------------------------------------------------------------------- - -aes_decipher_good_tls11() -> - [{doc,"Decipher a known TLS 1.1 cryptotext."}]. - -%% the fragment is actuall a TLS 1.1 record, with -%% Version = TLS 1.1, we get the correct NextIV in #cipher_state -aes_decipher_good_tls11(Config) when is_list(Config) -> - HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Content = <<"HELLO\n">>, - NextIV = <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>>, - Mac = <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>, - Version = {3,2}, - {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version), - Version1 = {3,2}, - {Content, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1), - ok. - -%%-------------------------------------------------------------------- - aes_decipher_fail() -> - [{doc,"Decipher a known cryptotext."}]. + [{doc,"Decipher a known cryptotext using a incorrect key"}]. -%% same as above, last byte of key replaced aes_decipher_fail(Config) when is_list(Config) -> HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Version = {3,0}, - {Content, Mac, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version), - 32 = byte_size(Content), - 32 = byte_size(Mac), - Version1 = {3,1}, - {Content1, Mac1, _} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1), - 32 = byte_size(Content1), - 32 = byte_size(Mac1), - ok. + CipherState = incorrect_cipher_state(), + decipher_check_fail(HashSz, CipherState, {3,0}), + decipher_check_fail(HashSz, CipherState, {3,1}), + decipher_check_fail(HashSz, CipherState, {3,2}), + decipher_check_fail(HashSz, CipherState, {3,3}). %%-------------------------------------------------------------------- - -aes_decipher_fail_tls11() -> - [{doc,"Decipher a known TLS 1.1 cryptotext."}]. - -%% same as above, last byte of key replaced -%% stricter padding checks in TLS 1.1 mean we get an alert instead -aes_decipher_fail_tls11(Config) when is_list(Config) -> - HashSz = 32, - CipherState = #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, - key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}, - Fragment = <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, - 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, - 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, - 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>, - Version = {3,2}, - #alert{level = ?FATAL, description = ?BAD_RECORD_MAC} = - ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version), - Version1 = {3,3}, - #alert{level = ?FATAL, description = ?BAD_RECORD_MAC} = - ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, Fragment, Version1), - ok. - +padding_test(Config) when is_list(Config) -> + HashSz = 16, + CipherState = correct_cipher_state(), + pad_test(HashSz, CipherState, {3,0}), + pad_test(HashSz, CipherState, {3,1}), + pad_test(HashSz, CipherState, {3,2}), + pad_test(HashSz, CipherState, {3,3}). + +%%-------------------------------------------------------------------- +% Internal functions -------------------------------------------------------- %%-------------------------------------------------------------------- +decipher_check_good(HashSz, CipherState, Version) -> + {Content, NextIV, Mac} = content_nextiv_mac(Version), + {Content, Mac, _} = + ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, aes_fragment(Version), Version, true). + +decipher_check_fail(HashSz, CipherState, Version) -> + {Content, NextIV, Mac} = content_nextiv_mac(Version), + true = {Content, Mac, #cipher_state{iv = NextIV}} =/= + ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, aes_fragment(Version), Version, true). + +pad_test(HashSz, CipherState, {3,0} = Version) -> + %% 3.0 does not have padding test + {Content, NextIV, Mac} = badpad_content_nextiv_mac(Version), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, badpad_aes_fragment({3,0}), {3,0}, true), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, badpad_aes_fragment({3,0}), {3,0}, false); +pad_test(HashSz, CipherState, {3,1} = Version) -> + %% 3.1 should have padding test, but may be disabled + {Content, NextIV, Mac} = badpad_content_nextiv_mac(Version), + BadCont = badpad_content(Content), + {Content, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, badpad_aes_fragment({3,1}) , {3,1}, false), + {BadCont, Mac, #cipher_state{iv = NextIV}} = + ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, badpad_aes_fragment({3,1}), {3,1}, true); +pad_test(HashSz, CipherState, Version) -> + %% 3.2 and 3.3 must have padding test + {Content, NextIV, Mac} = badpad_content_nextiv_mac(Version), + BadCont = badpad_content(Content), + {BadCont, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, + badpad_aes_fragment(Version), Version, false), + {BadCont, Mac, #cipher_state{iv = NextIV}} = ssl_cipher:decipher(?AES_CBC, HashSz, CipherState, + badpad_aes_fragment(Version), Version, true). + +aes_fragment({3,N}) when N == 0; N == 1-> + <<197,9,6,109,242,87,80,154,85,250,110,81,119,95,65,185,53,206,216,153,246,169, + 119,177,178,238,248,174,253,220,242,81,33,0,177,251,91,44,247,53,183,198,165, + 63,20,194,159,107>>; + +aes_fragment(_) -> + <<220,193,179,139,171,33,143,245,202,47,123,251,13,232,114,8, + 190,162,74,31,186,227,119,155,94,74,119,79,169,193,240,160, + 198,181,81,19,98,162,213,228,74,224,253,168,156,59,195,122, + 108,101,107,242,20,15,169,150,163,107,101,94,93,104,241,165>>. + +badpad_aes_fragment({3,N}) when N == 0; N == 1 -> + <<186,139,125,10,118,21,26,248,120,108,193,104,87,118,145,79,225,55,228,10,105, + 30,190,37,1,88,139,243,210,99,65,41>>; +badpad_aes_fragment(_) -> + <<137,31,14,77,228,80,76,103,183,125,55,250,68,190,123,131,117,23,229,180,207, + 94,121,137,117,157,109,99,113,61,190,138,131,229,201,120,142,179,172,48,77, + 234,19,240,33,38,91,93>>. + +content_nextiv_mac({3,N}) when N == 0; N == 1 -> + {<<"HELLO\n">>, + <<72,196,247,97,62,213,222,109,210,204,217,186,172,184, 197,148>>, + <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>}; +content_nextiv_mac(_) -> + {<<"HELLO\n">>, + <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>>, + <<71,136,212,107,223,200,70,232,127,116,148,205,232,35,158,113,237,174,15,217,192,168,35,8,6,107,107,233,25,174,90,111>>}. + +badpad_content_nextiv_mac({3,N}) when N == 0; N == 1 -> + {<<"HELLO\n">>, + <<225,55,228,10,105,30,190,37,1,88,139,243,210,99,65,41>>, + <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>> + }; +badpad_content_nextiv_mac(_) -> + {<<"HELLO\n">>, + <<133,211,45,189,179,229,56,86,11,178,239,159,14,160,253,140>>, + <<183,139,16,132,10,209,67,86,168,100,61,217,145,57,36,56>> + }. + +badpad_content(Content) -> + %% BadContent will fail mac test + <<16#F0, Content/binary>>. + +correct_cipher_state() -> + #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,148>>}. + +incorrect_cipher_state() -> + #cipher_state{iv = <<59,201,85,117,188,206,224,136,5,109,46,70,104,79,4,9>>, + key = <<72,196,247,97,62,213,222,109,210,204,217,186,172,184,197,254>>}. + diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index d2e6e41482..d6fbb73249 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -187,6 +187,7 @@ run_client(Opts) -> Transport = proplists:get_value(transport, Opts, ssl), Options = proplists:get_value(options, Opts), ct:log("~p:~p~n~p:connect(~p, ~p)@~p~n", [?MODULE,?LINE, Transport, Host, Port, Node]), + ct:log("SSLOpts: ~p", [Options]), case rpc:call(Node, Transport, connect, [Host, Port, Options]) of {ok, Socket} -> Pid ! {connected, Socket}, @@ -918,6 +919,10 @@ srp_dss_suites() -> {srp_dss, aes_256_cbc, sha}], ssl_cipher:filter_suites(Suites). +rc4_suites(Version) -> + Suites = ssl_cipher:rc4_suites(Version), + ssl_cipher:filter_suites(Suites). + pem_to_der(File) -> {ok, PemBin} = file:read_file(File), public_key:pem_decode(PemBin). @@ -1125,7 +1130,8 @@ filter_suites(Ciphers0) -> Supported0 = ssl_cipher:suites(Version) ++ ssl_cipher:anonymous_suites(Version) ++ ssl_cipher:psk_suites(Version) - ++ ssl_cipher:srp_suites(), + ++ ssl_cipher:srp_suites() + ++ ssl_cipher:rc4_suites(Version), Supported1 = ssl_cipher:filter_suites(Supported0), Supported2 = [ssl:suite_definition(S) || S <- Supported1], [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported2)]. diff --git a/lib/stdlib/doc/src/math.xml b/lib/stdlib/doc/src/math.xml index 43cd20e726..7cfc8a1175 100644 --- a/lib/stdlib/doc/src/math.xml +++ b/lib/stdlib/doc/src/math.xml @@ -67,6 +67,7 @@ <name name="atanh" arity="1"/> <name name="exp" arity="1"/> <name name="log" arity="1"/> + <name name="log2" arity="1"/> <name name="log10" arity="1"/> <name name="pow" arity="2"/> <name name="sqrt" arity="1"/> diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 26d8454731..b870ccf1f9 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -744,6 +744,8 @@ attribute_state(Form, St) -> %% State' %% Allow for record, type and opaque type definitions and spec %% declarations to be intersperced within function definitions. +%% Dialyzer attributes are also allowed everywhere, but are not +%% checked at all. function_state({attribute,L,record,{Name,Fields}}, St) -> record_def(L, Name, Fields, St); @@ -753,6 +755,8 @@ function_state({attribute,L,opaque,{TypeName,TypeDef,Args}}, St) -> type_def(opaque, L, TypeName, TypeDef, Args, St); function_state({attribute,L,spec,{Fun,Types}}, St) -> spec_decl(L, Fun, Types, St); +function_state({attribute,_L,dialyzer,_Val}, St) -> + St; function_state({attribute,La,Attr,_Val}, St) -> add_error(La, {attribute,Attr}, St); function_state({function,L,N,A,Cs}, St) -> diff --git a/lib/stdlib/src/math.erl b/lib/stdlib/src/math.erl index 98a70b1644..43f736e54c 100644 --- a/lib/stdlib/src/math.erl +++ b/lib/stdlib/src/math.erl @@ -24,7 +24,7 @@ -export([sin/1, cos/1, tan/1, asin/1, acos/1, atan/1, atan2/2, sinh/1, cosh/1, tanh/1, asinh/1, acosh/1, atanh/1, exp/1, log/1, - log10/1, pow/2, sqrt/1, erf/1, erfc/1]). + log2/1, log10/1, pow/2, sqrt/1, erf/1, erfc/1]). -spec acos(X) -> float() when X :: number(). @@ -92,6 +92,11 @@ exp(_) -> log(_) -> erlang:nif_error(undef). +-spec log2(X) -> float() when + X :: number(). +log2(_) -> + erlang:nif_error(undef). + -spec log10(X) -> float() when X :: number(). log10(_) -> diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl index 7e12eab1b5..3ca7a8197e 100644 --- a/lib/syntax_tools/src/epp_dodger.erl +++ b/lib/syntax_tools/src/epp_dodger.erl @@ -88,7 +88,7 @@ %% This is a so-called Erlang I/O ErrorInfo structure; see the {@link %% //stdlib/io} module for details. --type errorinfo() :: term(). % {integer(), atom(), term()}. +-type errorinfo() :: {integer(), atom(), term()}. -type option() :: atom() | {atom(), term()}. @@ -208,8 +208,8 @@ do_parse_file(DefEncoding, File, Parser, Options) -> try Parser(Dev, 1, Options) after ok = file:close(Dev) end; - {error, _} = Error -> - Error + {error, Error} -> + {error, {0, file, Error}} % defer to file:format_error/1 end. find_invalid_unicode([H|T]) -> diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index f1251fddab..d5ba8aa52f 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -305,7 +305,7 @@ handle_call({inspect, Lockname, InOpts}, _From, #state{ duration=Duration, locks {true, true} -> locks_ids(Filtered); _ -> [] end, - Combos = combine_classes(Filtered, proplists:get_value(combine, Opts)), + Combos = combine_classes(Filtered, proplists:get_value(combine, Opts)), case proplists:get_value(locations, Opts) of true -> lists:foreach(fun @@ -329,9 +329,8 @@ handle_call({inspect, Lockname, InOpts}, _From, #state{ duration=Duration, locks end end, Combos); _ -> - Print1 = locks2print(Combos, Duration), - Print2 = filter_print(Print1, Opts), - print_lock_information(Print2, proplists:get_value(print, Opts)) + Print = filter_print(locks2print(Combos, Duration), Opts), + print_lock_information(Print, proplists:get_value(print, Opts)) end, {reply, ok, State}; @@ -357,8 +356,7 @@ handle_call({histogram, Lockname, InOpts}, _From, #state{ duration=Duration, loc {thresholds, [{tries, -1}, {colls, -1}, {time, -1}]}], Opts), Prints = locks2print([L], Duration), print_lock_information(Prints, proplists:get_value(print, Opts1)), - print_full_histogram(SumStats#stats.hist), - io:format("~n") + print_full_histogram(SumStats#stats.hist) end, Combos), {reply, ok, State}; @@ -509,20 +507,23 @@ filter_locks(Locks, Lockname) -> % 4. max length of locks filter_print(PLs, Opts) -> - TLs = threshold_locks(PLs, proplists:get_value(thresholds, Opts, [])), - SLs = sort_locks(TLs, proplists:get_value(sort, Opts, time)), - CLs = cut_locks(SLs, proplists:get_value(max_locks, Opts, none)), - reverse_locks(CLs, not proplists:get_value(reverse,Opts, false)). - -sort_locks(Locks, name) -> lists:keysort(#print.name, Locks); -sort_locks(Locks, id) -> lists:keysort(#print.id, Locks); -sort_locks(Locks, type) -> lists:keysort(#print.type, Locks); -sort_locks(Locks, tries) -> lists:keysort(#print.tries, Locks); -sort_locks(Locks, colls) -> lists:keysort(#print.colls, Locks); -sort_locks(Locks, ratio) -> lists:keysort(#print.cr, Locks); -sort_locks(Locks, time) -> lists:keysort(#print.time, Locks); + TLs = threshold_locks(PLs, proplists:get_value(thresholds, Opts, [])), + SLs = sort_locks(TLs, proplists:get_value(sort, Opts, time)), + CLs = cut_locks(SLs, proplists:get_value(max_locks, Opts, none)), + reverse_locks(CLs, proplists:get_value(reverse, Opts, false)). + +sort_locks(Locks, name) -> reverse_sort_locks(#print.name, Locks); +sort_locks(Locks, id) -> reverse_sort_locks(#print.id, Locks); +sort_locks(Locks, type) -> reverse_sort_locks(#print.type, Locks); +sort_locks(Locks, tries) -> reverse_sort_locks(#print.tries, Locks); +sort_locks(Locks, colls) -> reverse_sort_locks(#print.colls, Locks); +sort_locks(Locks, ratio) -> reverse_sort_locks(#print.cr, Locks); +sort_locks(Locks, time) -> reverse_sort_locks(#print.time, Locks); sort_locks(Locks, _) -> sort_locks(Locks, time). +reverse_sort_locks(Ix, Locks) -> + lists:reverse(lists:keysort(Ix, Locks)). + % cut locks not above certain thresholds threshold_locks(Locks, Thresholds) -> Tries = proplists:get_value(tries, Thresholds, -1), @@ -647,15 +648,19 @@ format_histogram(Tup) when is_tuple(Tup) -> _ -> string_histogram([case V of 0 -> 0; _ -> V/Max end || V <- Vs]) end. -string_histogram([0|Vs]) -> - [$\s|string_histogram(Vs)]; -string_histogram([V|Vs]) when V > 0.66 -> - [$X|string_histogram(Vs)]; -string_histogram([V|Vs]) when V > 0.33 -> - [$x|string_histogram(Vs)]; -string_histogram([_|Vs]) -> - [$.|string_histogram(Vs)]; -string_histogram([]) -> []. +string_histogram(Vs) -> + [$||histogram_values_to_string(Vs,$|)]. + +histogram_values_to_string([0|Vs],End) -> + [$\s|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([V|Vs],End) when V > 0.66 -> + [$X|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([V|Vs],End) when V > 0.33 -> + [$x|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([_|Vs],End) -> + [$.|histogram_values_to_string(Vs,End)]; +histogram_values_to_string([],End) -> + [End]. %% state making @@ -778,7 +783,7 @@ auto_print_width(Locks, Print) -> ({print,print}, Out) -> [print|Out]; ({Str, Len}, Out) -> [erlang:min(erlang:max(length(s(Str))+1,Len),80)|Out] end, [], lists:zip(tuple_to_list(L), tuple_to_list(Max))))) - end, #print{ id = 4, type = 5, entry = 5, name = 6, tries = 8, colls = 13, cr = 16, time = 11, dtr = 14, hist=20 }, + end, #print{ id=4, type=5, entry=5, name=6, tries=8, colls=13, cr=16, time=11, dtr=14, hist=20 }, Locks), % Setup the offsets for later pruning Offsets = [ @@ -820,7 +825,7 @@ print_header(Opts) -> cr = "collisions [%]", time = "time [us]", dtr = "duration [%]", - hist = "histogram" + hist = "histogram [log2(us)]" }, Divider = #print{ name = lists:duplicate(1 + length(Header#print.name), 45), @@ -863,9 +868,9 @@ format_lock(L, [Opt|Opts]) -> {time, W} -> [{space, W, s(L#print.time) } | format_lock(L, Opts)]; duration -> [{space, 20, s(L#print.dtr) } | format_lock(L, Opts)]; {duration, W} -> [{space, W, s(L#print.dtr) } | format_lock(L, Opts)]; - histogram -> [{space, 0, s(L#print.hist) } | format_lock(L, Opts)]; - {histogram, W} -> [{space, W, s(L#print.hist) } | format_lock(L, Opts)]; - _ -> format_lock(L, Opts) + histogram -> [{space, 20, s(L#print.hist) } | format_lock(L, Opts)]; + {histogram, W} -> [{left, W - length(s(L#print.hist)) - 1, s(L#print.hist)} | format_lock(L, Opts)]; + _ -> format_lock(L, Opts) end. print_state_information(#state{locks = Locks} = State) -> @@ -926,6 +931,7 @@ s(T) -> term2string(T). strings(Strings) -> strings(Strings, []). strings([], Out) -> Out; strings([{space, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string("~~~ws", [N]), [S])); +strings([{left, N, S} | Ss], Out) -> strings(Ss, Out ++ term2string(term2string(" ~~s~~~ws", [N]), [S,""])); strings([{format, Format, S} | Ss], Out) -> strings(Ss, Out ++ term2string(Format, [S])); strings([S|Ss], Out) -> strings(Ss, Out ++ term2string("~ts", [S])). diff --git a/system/doc/reference_manual/modules.xml b/system/doc/reference_manual/modules.xml index 5fc8b363f8..5cb0c11371 100644 --- a/system/doc/reference_manual/modules.xml +++ b/system/doc/reference_manual/modules.xml @@ -194,8 +194,7 @@ behaviour_info(callbacks) -> Callbacks.</pre> </p> <pre> -type my_type() :: atom() | integer(). --spec my_function(integer()) -> integer(). - </pre> +-spec my_function(integer()) -> integer().</pre> <p>Read more in <seealso marker="typespec">Types and Function specifications</seealso>. </p> <p> diff --git a/system/doc/reference_manual/typespec.xml b/system/doc/reference_manual/typespec.xml index e4aa2ceda6..d1584d2b98 100644 --- a/system/doc/reference_manual/typespec.xml +++ b/system/doc/reference_manual/typespec.xml @@ -264,8 +264,10 @@ its violation results in a compilation error. </p> <note> - The following built-in list types also exist, - but they are expected to be rarely used. Hence, they have long names: + <p> + The following built-in list types also exist, + but they are expected to be rarely used. Hence, they have long names: + </p> </note> <pre> nonempty_maybe_improper_list() :: nonempty_maybe_improper_list(any(), any()) @@ -504,7 +506,9 @@ -spec foo({X, integer()}) -> X when X :: atom() ; ([Y]) -> Y when Y :: number().</pre> <note> + <p> For backwards compatibility the following form is also allowed: + </p> <pre> -spec id(X) -> X when is_subtype(X, tuple()).</pre> <p> but its use is discouraged. It will be taken out in a future |