diff options
Diffstat (limited to 'lib')
244 files changed, 7945 insertions, 2373 deletions
diff --git a/lib/asn1/src/asn1ct_gen.erl b/lib/asn1/src/asn1ct_gen.erl index 093bcb5a6c..6d5062a118 100644 --- a/lib/asn1/src/asn1ct_gen.erl +++ b/lib/asn1/src/asn1ct_gen.erl @@ -1289,6 +1289,7 @@ gen_head(Erules,Mod,Hrl) -> emit({"-module('",Mod,"').",nl}), put(currmod,Mod), emit({"-compile(nowarn_unused_vars).",nl}), + emit({"-dialyzer(no_improper_lists).",nl}), case Hrl of 0 -> ok; _ -> emit({"-include(\"",Mod,".hrl\").",nl}) diff --git a/lib/asn1/src/asn1ct_imm.erl b/lib/asn1/src/asn1ct_imm.erl index 527f4f0ba9..e09256cde9 100644 --- a/lib/asn1/src/asn1ct_imm.erl +++ b/lib/asn1/src/asn1ct_imm.erl @@ -1120,38 +1120,41 @@ per_enc_constrained(Val0, Lb, Ub, false) -> per_enc_constrained(Val0, Lb, Ub, true) -> {Prefix,Val} = sub_lb(Val0, Lb), Range = Ub - Lb + 1, + Check = {ult,Val,Range}, if Range < 256 -> NumBits = per_num_bits(Range), - Check = {ult,Val,Range}, Put = [{put_bits,Val,NumBits,[1]}], {Prefix,Check,Put}; Range =:= 256 -> NumBits = 8, - Check = {ult,Val,Range}, Put = [{put_bits,Val,NumBits,[1,align]}], {Prefix,Check,Put}; Range =< 65536 -> - Check = {ult,Val,Range}, Put = [{put_bits,Val,16,[1,align]}], {Prefix,Check,Put}; true -> - {var,VarBase} = Val, - Bin = {var,VarBase++"@bin"}, - BinSize0 = {var,VarBase++"@bin_size0"}, - BinSize = {var,VarBase++"@bin_size"}, - Check = {ult,Val,Range}, RangeOctsLen = byte_size(binary:encode_unsigned(Range - 1)), BitsNeeded = per_num_bits(RangeOctsLen), - Enc = [{call,binary,encode_unsigned,[Val],Bin}, - {call,erlang,byte_size,[Bin],BinSize0}, - {sub,BinSize0,1,BinSize}, - {'cond',[['_', - {put_bits,BinSize,BitsNeeded,[1]}, - {put_bits,Bin,binary,[8,align]}]]}], - {Prefix,Check,Enc} + {Prefix,Check,per_enc_constrained_huge(BitsNeeded, Val)} end. +per_enc_constrained_huge(BitsNeeded, {var,VarBase}=Val) -> + Bin = {var,VarBase++"@bin"}, + BinSize0 = {var,VarBase++"@bin_size0"}, + BinSize = {var,VarBase++"@bin_size"}, + [{call,binary,encode_unsigned,[Val],Bin}, + {call,erlang,byte_size,[Bin],BinSize0}, + {sub,BinSize0,1,BinSize}, + {'cond',[['_', + {put_bits,BinSize,BitsNeeded,[1]}, + {put_bits,Bin,binary,[8,align]}]]}]; +per_enc_constrained_huge(BitsNeeded, Val) when is_integer(Val) -> + Bin = binary:encode_unsigned(Val), + BinSize = erlang:byte_size(Bin), + [{put_bits,BinSize-1,BitsNeeded,[1]}, + {put_bits,Val,8*BinSize,[1,align]}]. + per_enc_unconstrained(Val, Aligned) -> case Aligned of false -> []; diff --git a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 index b4c011fd39..4fe0901683 100644 --- a/lib/asn1/test/asn1_SUITE_data/Prim.asn1 +++ b/lib/asn1/test/asn1_SUITE_data/Prim.asn1 @@ -60,4 +60,11 @@ BEGIN e BOOLEAN, magic INTEGER } + + Longitude ::= INTEGER { + oneMicrodegreeEast(10), + oneMicrodegreeWest(-10), + unavailable(1800000001) + } (-1799999999..1800000001) + END diff --git a/lib/asn1/test/asn1_test_lib.erl b/lib/asn1/test/asn1_test_lib.erl index 4fee5a64cc..ae2e5641ec 100644 --- a/lib/asn1/test/asn1_test_lib.erl +++ b/lib/asn1/test/asn1_test_lib.erl @@ -58,7 +58,7 @@ dialyze(Files) -> Beams0 = [code:which(module(F)) || F <- Files], Beams = [code:which(asn1rt_nif)|Beams0], case dialyzer:run([{files,Beams}, - {warnings,[no_improper_lists]}, + {warnings,[]}, {get_warnings,true}]) of [] -> ok; diff --git a/lib/asn1/test/testPrim.erl b/lib/asn1/test/testPrim.erl index 8fa9973ea5..dc2e0fa2e7 100644 --- a/lib/asn1/test/testPrim.erl +++ b/lib/asn1/test/testPrim.erl @@ -78,8 +78,37 @@ int(Rules) -> roundtrip('ASeq', {'ASeq',false,250,true,200,true,199,true,77788}), roundtrip('ASeq', {'ASeq',true,0,false,0,true,0,true,68789}), + %%========================================================== + %% Longitude ::= INTEGER { + %% oneMicrodegreeEast(10), + %% oneMicrodegreeWest(-10), + %% unavailable(1800000001) + %% } (-1799999999..1800000001) + %%========================================================== + + Enc10 = encoding(Rules, oneMicrodegreeEast), + Enc10 = roundtrip('Longitude', oneMicrodegreeEast), + Enc10 = roundtrip('Longitude', 10, oneMicrodegreeEast), + + Enc20 = encoding(Rules, oneMicrodegreeWest), + Enc20 = roundtrip('Longitude', oneMicrodegreeWest), + Enc20 = roundtrip('Longitude', -10, oneMicrodegreeWest), + + Enc30 = roundtrip('Longitude', unavailable), + Enc30 = roundtrip('Longitude', 1800000001, unavailable), + ok. +encoding(Rules, Type) -> + asn1_test_lib:hex_to_bin(encoding_1(Rules, Type)). + +encoding_1(ber, oneMicrodegreeEast) -> "02010A"; +encoding_1(per, oneMicrodegreeEast) -> "C06B49D2 09"; +encoding_1(uper, oneMicrodegreeEast) -> "6B49D209"; + +encoding_1(ber, oneMicrodegreeWest) -> "0201F6"; +encoding_1(per, oneMicrodegreeWest) -> "C06B49D1 F5"; +encoding_1(uper, oneMicrodegreeWest) -> "6B49D1F5". enum(Rules) -> diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index 14b6381230..d14be83496 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -142,11 +142,6 @@ bopt_block(Reg, Fail, OldIs, [{block,Bl0}|Acc0], St0) -> throw:not_boolean_expr -> failed; - %% 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 @@ -215,37 +210,14 @@ ensure_opt_safe(Bl, NewCode, OldIs, Fail, PrecedingCode, St) -> false -> throw(all_registers_not_killed); true -> ok end, - Same = assigned_same_value(Bl, NewCode), MustBeUnused = ordsets:subtract(ordsets:union(NotSet, NewDst), - ordsets:union(MustBeKilled, Same)), + MustBeKilled), case none_used(MustBeUnused, OldIs, Fail, St) of false -> throw(registers_used); true -> ok end, ok. -%% assigned_same_value(OldCode, NewCodeReversed) -> [DestinationRegs] -%% Return an ordset with a list of all y registers that are always -%% assigned the same value in the old and new code. Currently, we -%% are very conservative in that we only consider identical move -%% instructions in the same order. -%% -assigned_same_value(Old, New) -> - case reverse(New) of - [{block,Bl}|_] -> - assigned_same_value(Old, Bl, []); - _ -> - ordsets:new() - end. - -assigned_same_value([{set,[{y,_}=D],[S],move}|T1], - [{set,[{y,_}=D],[S],move}|T2], Acc) -> - assigned_same_value(T1, T2, [D|Acc]); -assigned_same_value(_, _, Acc) -> - ordsets:from_list(Acc). - -update_fail_label([{set,_,_,move}=I|Is], Fail, Acc) -> - update_fail_label(Is, Fail, [I|Acc]); update_fail_label([{set,Ds,As,{bif,N,{f,_}}}|Is], Fail, Acc) -> update_fail_label(Is, Fail, [{set,Ds,As,{bif,N,{f,Fail}}}|Acc]); update_fail_label([{set,Ds,As,{alloc,Regs,{gc_bif,N,{f,_}}}}|Is], Fail, Acc) -> @@ -314,8 +286,6 @@ split_block_1(Is, Fail, ProhibitFailLabel) -> end end. -split_block_2([{set,_,_,move}=I|Is], Fail, Acc) -> - split_block_2(Is, Fail, [I|Acc]); split_block_2([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) -> split_block_2(Is, Fail, [I|Acc]); split_block_2([{set,[_],_,{alloc,_,{gc_bif,_,{f,Fail}}}}=I|Is], Fail, Acc) -> @@ -343,8 +313,6 @@ dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); dst_regs([{set,[D],_,{alloc,_,{gc_bif,_,{f,_}}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); -dst_regs([{set,[D],_,move}|Is], Acc) -> - dst_regs(Is, [D|Acc]); dst_regs([_|Is], Acc) -> dst_regs(Is, Acc); dst_regs([], Acc) -> ordsets:from_list(Acc). @@ -411,13 +379,6 @@ bopt_tree([{protected,[Dst],Code,_}|Is], Forest0, Pre) -> _Res -> throw(not_boolean_expr) end; -bopt_tree([{set,[Dst],[Src],move}=Move|Is], Forest, Pre) -> - case {Src,Dst} of - {{tmp,_},_} -> throw(move); - {_,{tmp,_}} -> throw(move); - _ -> ok - end, - bopt_tree(Is, Forest, [Move|Pre]); bopt_tree([{set,[Dst],As,{bif,N,_}}=Bif|Is], Forest0, Pre) -> Ar = length(As), case safe_bool_op(N, Ar) of @@ -589,10 +550,6 @@ free_variables(Is) -> E = gb_sets:empty(), free_vars_1(Is, E, E, E). -free_vars_1([{set,Ds,As,move}|Is], F0, N0, A) -> - F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), - N = gb_sets:union(N0, var_list(Ds)), - free_vars_1(Is, F, N, A); free_vars_1([{set,Ds,As,{bif,_,_}}|Is], F0, N0, A) -> F = gb_sets:union(F0, gb_sets:difference(var_list(As), N0)), N = gb_sets:union(N0, var_list(Ds)), @@ -632,8 +589,6 @@ free_vars_regs(X) -> [{x,X-1}|free_vars_regs(X-1)]. rename_regs(Is, Regs) -> rename_regs(Is, Regs, []). -rename_regs([{set,_,_,move}=I|Is], Regs, Acc) -> - rename_regs(Is, Regs, [I|Acc]); rename_regs([{set,[Dst0],Ss0,{alloc,_,Info}}|Is], Regs0, Acc) -> Live = live_regs(Regs0), Ss = rename_sources(Ss0, Regs0), @@ -737,8 +692,7 @@ ssa_assign({x,_}=R, #ssa{sub=Sub0}=Ssa0) -> Sub1 = gb_trees:update(R, NewReg, Sub0), Sub = gb_trees:insert(NewReg, NewReg, Sub1), Ssa#ssa{sub=Sub} - end; -ssa_assign(_, Ssa) -> Ssa. + end. ssa_sub_list(List, Sub) -> [ssa_sub(E, Sub) || E <- List]. diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 4f76350269..62356928ae 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -421,7 +421,8 @@ btb_follow_branches([], _, D) -> D. btb_follow_branch(0, _Regs, D) -> D; btb_follow_branch(Lbl, Regs, #btb{ok_br=Br0,index=Li}=D) -> - case gb_sets:is_member(Lbl, Br0) of + Key = {Lbl,Regs}, + case gb_sets:is_member(Key, Br0) of true -> %% We have already followed this branch and it was OK. D; @@ -432,7 +433,7 @@ btb_follow_branch(Lbl, Regs, #btb{ok_br=Br0,index=Li}=D) -> btb_reaches_match_1(Is, Regs, D), %% Since we got back, this branch is OK. - D#btb{ok_br=gb_sets:insert(Lbl, Br),must_not_save=MustNotSave, + D#btb{ok_br=gb_sets:insert(Key, Br),must_not_save=MustNotSave, must_save=MustSave} end. diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 010327b5e3..e7a2b8177a 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -1598,13 +1598,20 @@ is_c_map(#c_literal{val = V}) when is_map(V) -> is_c_map(_) -> false. --spec map_es(c_map()) -> [c_map_pair()]. +-spec map_es(c_map() | c_literal()) -> [c_map_pair()]. +map_es(#c_literal{anno=As,val=M}) when is_map(M) -> + [ann_c_map_pair(As, + #c_literal{anno=As,val='assoc'}, + #c_literal{anno=As,val=K}, + #c_literal{anno=As,val=V}) || {K,V} <- maps:to_list(M)]; map_es(#c_map{es = Es}) -> Es. --spec map_arg(c_map()) -> c_map() | c_literal(). +-spec map_arg(c_map() | c_literal()) -> c_map() | c_literal(). +map_arg(#c_literal{anno=As,val=M}) when is_map(M) -> + #c_literal{anno=As,val=#{}}; map_arg(#c_map{arg=M}) -> M. diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index 34c67b16ca..2a89305f4d 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1327,12 +1327,13 @@ bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> %% that we save any variable that will be live after this BIF call. MayFail = not erl_bifs:is_safe(erlang, Bif, length(As)), - {Sis,Int0} = case St0#cg.in_catch andalso - St0#cg.bfail =:= 0 andalso - MayFail of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = + case MayFail of + true -> + maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0); + false -> + {[],Bef} + end, Int1 = clear_dead(Int0, Le#l.i, Vdb), Reg = put_reg(V, Int1#sr.reg), Int = Int1#sr{reg=Reg}, @@ -1363,11 +1364,7 @@ gc_bif_cg(Bif, As, [{var,V}], Le, Vdb, Bef, St0) -> %% Currently, we are somewhat pessimistic in %% that we save any variable that will be live after this BIF call. - {Sis,Int0} = - case St0#cg.in_catch andalso St0#cg.bfail =:= 0 of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St0), Int1 = clear_dead(Int0, Le#l.i, Vdb), Reg = put_reg(V, Int1#sr.reg), @@ -1512,8 +1509,7 @@ set_cg([{var,R}], {cons,Es}, Le, Vdb, Bef, St) -> Int1 = Int0#sr{reg=put_reg(R, Int0#sr.reg)}, Ret = fetch_reg(R, Int1#sr.reg), {[{put_list,S1,S2,Ret}], Int1, St}; -set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, - #cg{in_catch=InCatch, bfail=Bfail}=St) -> +set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, #cg{bfail=Bfail}=St) -> %% At run-time, binaries are constructed in three stages: %% 1) First the size of the binary is calculated. %% 2) Then the binary is allocated. @@ -1532,11 +1528,7 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, %% First generate the code that constructs each field. Fail = {f,Bfail}, PutCode = cg_bin_put(Segs, Fail, Bef), - {Sis,Int1} = - case InCatch of - true -> adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Int0} - end, + {Sis,Int1} = maybe_adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb, St), MaxRegs = max_reg(Bef#sr.reg), Aft = clear_dead(Int1, Le#l.i, Vdb), @@ -1545,14 +1537,11 @@ set_cg([{var,R}], {binary,Segs}, Le, Vdb, Bef, {Sis++Code,Aft,St}; % Map single variable key set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, - #cg{in_catch=InCatch,bfail=Bfail}=St) -> + #cg{bfail=Bfail}=St) -> Fail = {f,Bfail}, - {Sis,Int0} = - case InCatch of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), + SrcReg = cg_reg_arg(Map,Int0), Line = line(Le#l.a), @@ -1573,17 +1562,13 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, % Map (possibly) multiple literal keys set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, - #cg{in_catch=InCatch,bfail=Bfail}=St) -> + #cg{bfail=Bfail}=St) -> %% assert key literals [] = [Var||{map_pair,{var,_}=Var,_} <- Es], Fail = {f,Bfail}, - {Sis,Int0} = - case InCatch of - true -> adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb); - false -> {[],Bef} - end, + {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), SrcReg = cg_reg_arg(Map,Int0), Line = line(Le#l.a), @@ -2038,6 +2023,19 @@ trim_free([R|Rs0]) -> end; trim_free([]) -> []. +%% maybe_adjust_stack(Bef, FirstBefore, LastFrom, Vdb, St) -> {[Ainstr],Aft}. +%% Adjust the stack, but only if the code is inside a catch and not +%% inside a guard. Use this funtion before instructions that may +%% cause an exception. + +maybe_adjust_stack(Bef, Fb, Lf, Vdb, St) -> + case St of + #cg{in_catch=true,bfail=0} -> + adjust_stack(Bef, Fb, Lf, Vdb); + #cg{} -> + {[],Bef} + end. + %% adjust_stack(Bef, FirstBefore, LastFrom, Vdb) -> {[Ainstr],Aft}. %% Do complete stack adjustment by compressing stack and adding %% variables to be saved. Try to optimise ordering on stack by diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 0941ad5dd5..7d93e2ae16 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -804,7 +804,7 @@ map_op(map_field_assoc) -> #c_literal{val=assoc}; map_op(map_field_exact) -> #c_literal{val=exact}. is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true; -is_valid_map_src(#c_var{}) -> true; +is_valid_map_src(#c_var{}=Var) -> not cerl:is_c_fname(Var); is_valid_map_src(_) -> false. %% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index b4601b0798..7fb0a16540 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -36,7 +36,8 @@ 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,binary_in_map/1, - match_string_opt/1,map_and_binary/1]). + match_string_opt/1,map_and_binary/1, + unsafe_branch_caching/1]). -export([coverage_id/1,coverage_external_ignore/2]). @@ -62,7 +63,8 @@ groups() -> otp_7498,match_string,zero_width,bad_size,haystack, cover_beam_bool,matched_out_size,follow_fail_branch, no_partition,calling_a_binary,binary_in_map, - match_string_opt,map_and_binary]}]. + match_string_opt,map_and_binary, + unsafe_branch_caching]}]. init_per_suite(Config) -> @@ -1243,6 +1245,32 @@ do_map_and_binary(#{time := _} = T) -> do_map_and_binary(#{hour := Hour, min := Min} = T) -> {Hour, Min, T}. +%% Unsafe caching of branch outcomes in beam_bsm would cause the +%% delayed creation of sub-binaries optimization to be applied even +%% when it was unsafe. + +unsafe_branch_caching(_Config) -> + <<>> = do_unsafe_branch_caching(<<42,1>>), + <<>> = do_unsafe_branch_caching(<<42,2>>), + <<>> = do_unsafe_branch_caching(<<42,3>>), + <<17,18>> = do_unsafe_branch_caching(<<42,3,17,18>>), + <<>> = do_unsafe_branch_caching(<<1,3,42,2>>), + + ok. + +do_unsafe_branch_caching(<<Code/integer, Bin/binary>>) -> + <<C1/integer, B1/binary>> = Bin, + case C1 of + X when X =:= 1 orelse X =:= 2 -> + Bin2 = <<>>; + _ -> + Bin2 = B1 + end, + case Code of + 1 -> do_unsafe_branch_caching(Bin2); + _ -> Bin2 + end. + check(F, R) -> R = F(). diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index b3b67155b3..47eb1ba78b 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -34,7 +34,8 @@ tricky/1,rel_ops/1,rel_op_combinations/1,literal_type_tests/1, basic_andalso_orelse/1,traverse_dcd/1, check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1, - bad_constants/1,bad_guards/1]). + bad_constants/1,bad_guards/1,scotland/1, + guard_in_catch/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -52,7 +53,7 @@ groups() -> rel_ops,rel_op_combinations, literal_type_tests,basic_andalso_orelse,traverse_dcd, check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, - bad_constants,bad_guards]}]. + bad_constants,bad_guards,scotland,guard_in_catch]}]. init_per_suite(Config) -> Config. @@ -1831,6 +1832,80 @@ bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) -> bad_guards_3(M, [_]) when is_map(M) andalso M#{a := 0, b => 0}, length(M) -> ok. +%% beam_bool would remove the initialization of {y,0}. +%% (Thanks to Thomas Arts and QuickCheck.) + +scotland(_Config) -> + million = do_scotland(placed), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(false)), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(true)), + {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(echo)), + ok. + +do_scotland(Echo) -> + found(case Echo of + Echo when true; Echo, Echo, Echo -> + Echo; + echo -> + [] + end, + Echo = placed). + +found(_, _) -> million. + +%% Building maps in a guard in a 'catch' would crash v3_codegen. + +guard_in_catch(_Config) -> + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_1(#{}), + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_1(#{a=>b}), + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_1(atom), + + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_2(#{}), + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_2(#{a=>b}), + {'EXIT',{if_clause,_}} = do_guard_in_catch_map_2(atom), + + {'EXIT',{if_clause,_}} = (catch do_guard_in_catch_map_3()), + + {'EXIT',{if_clause,_}} = do_guard_in_catch_bin(42), + {'EXIT',{if_clause,_}} = do_guard_in_catch_bin(<<1,2,3>>), + {'EXIT',{if_clause,_}} = do_guard_in_catch_bin(atom), + {'EXIT',{if_clause,_}} = do_guard_in_catch_bin(#{}), + + ok. + +do_guard_in_catch_map_1(From) -> + catch + if + From#{[] => sufficient} -> + saint + end. + +do_guard_in_catch_map_2(From) -> + catch + if + From#{From => sufficient} -> + saint + end. + +do_guard_in_catch_map_3() -> + try + if [] -> solo end + catch + Friendly when Friendly#{0 => []} -> minutes + after + membership + end. + +do_guard_in_catch_bin(From) -> + %% Would not crash v3_codegen, but there would be an unnecessary + %% 'move' to a Y register. + catch + if + <<From:32>> -> + saint + end. + + %% Call this function to turn off constant propagation. id(I) -> I. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 411b15eebe..cff3b5deb4 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -883,6 +883,9 @@ t_update_map_expressions(Config) when is_list(Config) -> %% Error cases. {'EXIT',{{badmap,<<>>},_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), {'EXIT',{{badmap,[]},_}} = (catch (id([]))#{ a := 42, b => 2 }), + {'EXIT',{{badmap,_},_}} = + (catch (fun t_update_map_expressions/1)#{u => 42}), + ok. diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index 9de8dc74c2..4966701e41 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -2042,6 +2042,7 @@ static ERL_NIF_TERM aes_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a ErlNifBinary key_bin, data_bin; AES_KEY aes_key; int i; + int j; unsigned char* ret_ptr; ERL_NIF_TERM ret; @@ -2064,7 +2065,9 @@ static ERL_NIF_TERM aes_ecb_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM a } ret_ptr = enif_make_new_binary(env, data_bin.size, &ret); - AES_ecb_encrypt(data_bin.data, ret_ptr, &aes_key, i); + for (j = 0; j < data_bin.size; j += 16) { + AES_ecb_encrypt(data_bin.data+j, ret_ptr+j, &aes_key, i); + } CONSUME_REDS(env,data_bin); return ret; } @@ -3566,6 +3569,9 @@ static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg) } else goto out_err; + if (!group) + goto out_err; + if (enif_inspect_binary(env, prime[2], &seed)) { EC_GROUP_set_seed(group, seed.data, seed.size); } diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index e84f5e1075..307fc4b019 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -1301,7 +1301,23 @@ aes_ecb() -> <<"0000000000000000">>}, {aes_ecb, <<"FEDCBA9876543210">>, - <<"FFFFFFFFFFFFFFFF">>} + <<"FFFFFFFFFFFFFFFF">>}, + %% AES ECB test vectors from http://csrc.nist.gov/publications/nistpubs/800-38a/sp800-38a.pdf + %% F.1.1 ECB-AES128.Encrypt, F.1.2 ECB-AES128.Decrypt + {aes_ecb, + hexstr2bin("2b7e151628aed2a6abf7158809cf4f3c"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710")}, + %% F.1.5 ECB-AES256.Encrypt, F.1.6 ECB-AES256.Decrypt + {aes_ecb, + hexstr2bin("603deb1015ca71be2b73aef0857d7781" + "1f352c073b6108d72d9810a30914dff4"), + hexstr2bin("6bc1bee22e409f96e93d7e117393172a" + "ae2d8a571e03ac9c9eb76fac45af8e51" + "30c81c46a35ce411e5fbc1191a0a52ef" + "f69f2445df4f9b17ad2b417be66c3710")} ]. aes_ige256() -> @@ -1885,7 +1901,7 @@ dss_params() -> 18320614775012672475365915366944922415598782131828709277168615511695849821411624805195787607930033958243224786899641459701930253094446221381818858674389863050420226114787005820357372837321561754462061849169568607689530279303056075793886577588606958623645901271866346406773590024901668622321064384483571751669]. ec_key_named() -> - Curve = secp112r2, + Curve = hd(crypto:ec_curves()), {D2_pub, D2_priv} = crypto:generate_key(ecdh, Curve), {[D2_priv, Curve], [D2_pub, Curve]}. @@ -2054,88 +2070,94 @@ srp(ClientPrivate, Generator, Prime, Version, Verifier, ServerPublic, ServerPriv SessionKey}. ecdh() -> %% http://csrc.nist.gov/groups/STM/cavp/ - [{ecdh, hexstr2point("42ea6dd9969dd2a61fea1aac7f8e98edcc896c6e55857cc0", "dfbe5d7c61fac88b11811bde328e8a0d12bf01a9d204b523"), - hexstr2bin("f17d3fea367b74d340851ca4270dcb24c271f445bed9d527"), - secp192r1, - hexstr2bin("803d8ab2e5b6e6fca715737c3a82f7ce3c783124f6d51cd0")}, - {ecdh, hexstr2point("deb5712fa027ac8d2f22c455ccb73a91e17b6512b5e030e7", "7e2690a02cc9b28708431a29fb54b87b1f0c14e011ac2125"), - hexstr2bin("56e853349d96fe4c442448dacb7cf92bb7a95dcf574a9bd5"), - secp192r1, - hexstr2bin("c208847568b98835d7312cef1f97f7aa298283152313c29d")}, - {ecdh, hexstr2point("af33cd0629bc7e996320a3f40368f74de8704fa37b8fab69abaae280", "882092ccbba7930f419a8a4f9bb16978bbc3838729992559a6f2e2d7"), - hexstr2bin("8346a60fc6f293ca5a0d2af68ba71d1dd389e5e40837942df3e43cbd"), - secp224r1, - hexstr2bin("7d96f9a3bd3c05cf5cc37feb8b9d5209d5c2597464dec3e9983743e8")}, - {ecdh, hexstr2point("13bfcd4f8e9442393cab8fb46b9f0566c226b22b37076976f0617a46", "eeb2427529b288c63c2f8963c1e473df2fca6caa90d52e2f8db56dd4"), - hexstr2bin("043cb216f4b72cdf7629d63720a54aee0c99eb32d74477dac0c2f73d"), - secp224r1, - hexstr2bin("ee93ce06b89ff72009e858c68eb708e7bc79ee0300f73bed69bbca09")}, - {ecdh, hexstr2point("700c48f77f56584c5cc632ca65640db91b6bacce3a4df6b42ce7cc838833d287", "db71e509e3fd9b060ddb20ba5c51dcc5948d46fbf640dfe0441782cab85fa4ac"), - hexstr2bin("7d7dc5f71eb29ddaf80d6214632eeae03d9058af1fb6d22ed80badb62bc1a534"), - secp256r1, - hexstr2bin("46fc62106420ff012e54a434fbdd2d25ccc5852060561e68040dd7778997bd7b")}, - {ecdh, hexstr2point("809f04289c64348c01515eb03d5ce7ac1a8cb9498f5caa50197e58d43a86a7ae", "b29d84e811197f25eba8f5194092cb6ff440e26d4421011372461f579271cda3"), - hexstr2bin("38f65d6dce47676044d58ce5139582d568f64bb16098d179dbab07741dd5caf5"), - secp256r1, - hexstr2bin("057d636096cb80b67a8c038c890e887d1adfa4195e9b3ce241c8a778c59cda67")}, - {ecdh, hexstr2point("a7c76b970c3b5fe8b05d2838ae04ab47697b9eaf52e764592efda27fe7513272734466b400091adbf2d68c58e0c50066", "ac68f19f2e1cb879aed43a9969b91a0839c4c38a49749b661efedf243451915ed0905a32b060992b468c64766fc8437a"), - hexstr2bin("3cc3122a68f0d95027ad38c067916ba0eb8c38894d22e1b15618b6818a661774ad463b205da88cf699ab4d43c9cf98a1"), - secp384r1, - hexstr2bin("5f9d29dc5e31a163060356213669c8ce132e22f57c9a04f40ba7fcead493b457e5621e766c40a2e3d4d6a04b25e533f1")}, - {ecdh, hexstr2point("30f43fcf2b6b00de53f624f1543090681839717d53c7c955d1d69efaf0349b7363acb447240101cbb3af6641ce4b88e0", "25e46c0c54f0162a77efcc27b6ea792002ae2ba82714299c860857a68153ab62e525ec0530d81b5aa15897981e858757"), - hexstr2bin("92860c21bde06165f8e900c687f8ef0a05d14f290b3f07d8b3a8cc6404366e5d5119cd6d03fb12dc58e89f13df9cd783"), - secp384r1, - hexstr2bin("a23742a2c267d7425fda94b93f93bbcc24791ac51cd8fd501a238d40812f4cbfc59aac9520d758cf789c76300c69d2ff")}, - {ecdh, hexstr2point("00685a48e86c79f0f0875f7bc18d25eb5fc8c0b07e5da4f4370f3a9490340854334b1e1b87fa395464c60626124a4e70d0f785601d37c09870ebf176666877a2046d", "01ba52c56fc8776d9e8f5db4f0cc27636d0b741bbe05400697942e80b739884a83bde99e0f6716939e632bc8986fa18dccd443a348b6c3e522497955a4f3c302f676"), - hexstr2bin("017eecc07ab4b329068fba65e56a1f8890aa935e57134ae0ffcce802735151f4eac6564f6ee9974c5e6887a1fefee5743ae2241bfeb95d5ce31ddcb6f9edb4d6fc47"), - secp521r1, - hexstr2bin("005fc70477c3e63bc3954bd0df3ea0d1f41ee21746ed95fc5e1fdf90930d5e136672d72cc770742d1711c3c3a4c334a0ad9759436a4d3c5bf6e74b9578fac148c831")}, - {ecdh, hexstr2point("01df277c152108349bc34d539ee0cf06b24f5d3500677b4445453ccc21409453aafb8a72a0be9ebe54d12270aa51b3ab7f316aa5e74a951c5e53f74cd95fc29aee7a", "013d52f33a9f3c14384d1587fa8abe7aed74bc33749ad9c570b471776422c7d4505d9b0a96b3bfac041e4c6a6990ae7f700e5b4a6640229112deafa0cd8bb0d089b0"), - hexstr2bin("00816f19c1fb10ef94d4a1d81c156ec3d1de08b66761f03f06ee4bb9dcebbbfe1eaa1ed49a6a990838d8ed318c14d74cc872f95d05d07ad50f621ceb620cd905cfb8"), - secp521r1, - hexstr2bin("000b3920ac830ade812c8f96805da2236e002acbbf13596a9ab254d44d0e91b6255ebf1229f366fb5a05c5884ef46032c26d42189273ca4efa4c3db6bd12a6853759")}, - - %% RFC-6954, Appendix A - {ecdh, hexstr2point("A9C21A569759DA95E0387041184261440327AFE33141CA04B82DC92E", - "98A0F75FBBF61D8E58AE5511B2BCDBE8E549B31E37069A2825F590C1"), - hexstr2bin("6060552303899E2140715816C45B57D9B42204FB6A5BF5BEAC10DB00"), - brainpoolP224r1, - hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")}, - {ecdh, hexstr2point("034A56C550FF88056144E6DD56070F54B0135976B5BF77827313F36B", - "75165AD99347DC86CAAB1CBB579E198EAF88DC35F927B358AA683681"), - hexstr2bin("39F155483CEE191FBECFE9C81D8AB1A03CDA6790E7184ACE44BCA161"), - brainpoolP224r1, - hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")}, - {ecdh, hexstr2point("44106E913F92BC02A1705D9953A8414DB95E1AAA49E81D9E85F929A8E3100BE5", - "8AB4846F11CACCB73CE49CBDD120F5A900A69FD32C272223F789EF10EB089BDC"), - hexstr2bin("55E40BC41E37E3E2AD25C3C6654511FFA8474A91A0032087593852D3E7D76BD3"), - brainpoolP256r1, - hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")}, - {ecdh, hexstr2point("8D2D688C6CF93E1160AD04CC4429117DC2C41825E1E9FCA0ADDD34E6F1B39F7B", - "990C57520812BE512641E47034832106BC7D3E8DD0E4C7F1136D7006547CEC6A"), - hexstr2bin("81DB1EE100150FF2EA338D708271BE38300CB54241D79950F77B063039804F1D"), - brainpoolP256r1, - hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")}, - {ecdh, hexstr2point("68B665DD91C195800650CDD363C625F4E742E8134667B767B1B476793588F885AB698C852D4A6E77A252D6380FCAF068", - "55BC91A39C9EC01DEE36017B7D673A931236D2F1F5C83942D049E3FA20607493E0D038FF2FD30C2AB67D15C85F7FAA59"), - hexstr2bin("032640BC6003C59260F7250C3DB58CE647F98E1260ACCE4ACDA3DD869F74E01F8BA5E0324309DB6A9831497ABAC96670"), - brainpoolP384r1, - hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")}, - {ecdh, hexstr2point("4D44326F269A597A5B58BBA565DA5556ED7FD9A8A9EB76C25F46DB69D19DC8CE6AD18E404B15738B2086DF37E71D1EB4", - "62D692136DE56CBE93BF5FA3188EF58BC8A3A0EC6C1E151A21038A42E9185329B5B275903D192F8D4E1F32FE9CC78C48"), - hexstr2bin("1E20F5E048A5886F1F157C74E91BDE2B98C8B52D58E5003D57053FC4B0BD65D6F15EB5D1EE1610DF870795143627D042"), - brainpoolP384r1, - hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")}, - {ecdh, hexstr2point("0A420517E406AAC0ACDCE90FCD71487718D3B953EFD7FBEC5F7F27E28C6149999397E91E029E06457DB2D3E640668B392C2A7E737A7F0BF04436D11640FD09FD", - "72E6882E8DB28AAD36237CD25D580DB23783961C8DC52DFA2EC138AD472A0FCEF3887CF62B623B2A87DE5C588301EA3E5FC269B373B60724F5E82A6AD147FDE7"), - hexstr2bin("230E18E1BCC88A362FA54E4EA3902009292F7F8033624FD471B5D8ACE49D12CFABBC19963DAB8E2F1EBA00BFFB29E4D72D13F2224562F405CB80503666B25429"), - brainpoolP512r1, - hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}, - {ecdh, hexstr2point("9D45F66DE5D67E2E6DB6E93A59CE0BB48106097FF78A081DE781CDB31FCE8CCBAAEA8DD4320C4119F1E9CD437A2EAB3731FA9668AB268D871DEDA55A5473199F", - "2FDC313095BCDD5FB3A91636F07A959C8E86B5636A1E930E8396049CB481961D365CC11453A06C719835475B12CB52FC3C383BCE35E27EF194512B71876285FA"), - hexstr2bin("16302FF0DBBB5A8D733DAB7141C1B45ACBC8715939677F6A56850A38BD87BD59B09E80279609FF333EB9D4C061231FB26F92EEB04982A5F1D1764CAD57665422"), - brainpoolP512r1, - hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}]. + Curves = crypto:ec_curves(), + TestCases = + [{ecdh, hexstr2point("42ea6dd9969dd2a61fea1aac7f8e98edcc896c6e55857cc0", "dfbe5d7c61fac88b11811bde328e8a0d12bf01a9d204b523"), + hexstr2bin("f17d3fea367b74d340851ca4270dcb24c271f445bed9d527"), + secp192r1, + hexstr2bin("803d8ab2e5b6e6fca715737c3a82f7ce3c783124f6d51cd0")}, + {ecdh, hexstr2point("deb5712fa027ac8d2f22c455ccb73a91e17b6512b5e030e7", "7e2690a02cc9b28708431a29fb54b87b1f0c14e011ac2125"), + hexstr2bin("56e853349d96fe4c442448dacb7cf92bb7a95dcf574a9bd5"), + secp192r1, + hexstr2bin("c208847568b98835d7312cef1f97f7aa298283152313c29d")}, + {ecdh, hexstr2point("af33cd0629bc7e996320a3f40368f74de8704fa37b8fab69abaae280", "882092ccbba7930f419a8a4f9bb16978bbc3838729992559a6f2e2d7"), + hexstr2bin("8346a60fc6f293ca5a0d2af68ba71d1dd389e5e40837942df3e43cbd"), + secp224r1, + hexstr2bin("7d96f9a3bd3c05cf5cc37feb8b9d5209d5c2597464dec3e9983743e8")}, + {ecdh, hexstr2point("13bfcd4f8e9442393cab8fb46b9f0566c226b22b37076976f0617a46", "eeb2427529b288c63c2f8963c1e473df2fca6caa90d52e2f8db56dd4"), + hexstr2bin("043cb216f4b72cdf7629d63720a54aee0c99eb32d74477dac0c2f73d"), + secp224r1, + hexstr2bin("ee93ce06b89ff72009e858c68eb708e7bc79ee0300f73bed69bbca09")}, + {ecdh, hexstr2point("700c48f77f56584c5cc632ca65640db91b6bacce3a4df6b42ce7cc838833d287", "db71e509e3fd9b060ddb20ba5c51dcc5948d46fbf640dfe0441782cab85fa4ac"), + hexstr2bin("7d7dc5f71eb29ddaf80d6214632eeae03d9058af1fb6d22ed80badb62bc1a534"), + secp256r1, + hexstr2bin("46fc62106420ff012e54a434fbdd2d25ccc5852060561e68040dd7778997bd7b")}, + {ecdh, hexstr2point("809f04289c64348c01515eb03d5ce7ac1a8cb9498f5caa50197e58d43a86a7ae", "b29d84e811197f25eba8f5194092cb6ff440e26d4421011372461f579271cda3"), + hexstr2bin("38f65d6dce47676044d58ce5139582d568f64bb16098d179dbab07741dd5caf5"), + secp256r1, + hexstr2bin("057d636096cb80b67a8c038c890e887d1adfa4195e9b3ce241c8a778c59cda67")}, + {ecdh, hexstr2point("a7c76b970c3b5fe8b05d2838ae04ab47697b9eaf52e764592efda27fe7513272734466b400091adbf2d68c58e0c50066", "ac68f19f2e1cb879aed43a9969b91a0839c4c38a49749b661efedf243451915ed0905a32b060992b468c64766fc8437a"), + hexstr2bin("3cc3122a68f0d95027ad38c067916ba0eb8c38894d22e1b15618b6818a661774ad463b205da88cf699ab4d43c9cf98a1"), + secp384r1, + hexstr2bin("5f9d29dc5e31a163060356213669c8ce132e22f57c9a04f40ba7fcead493b457e5621e766c40a2e3d4d6a04b25e533f1")}, + {ecdh, hexstr2point("30f43fcf2b6b00de53f624f1543090681839717d53c7c955d1d69efaf0349b7363acb447240101cbb3af6641ce4b88e0", "25e46c0c54f0162a77efcc27b6ea792002ae2ba82714299c860857a68153ab62e525ec0530d81b5aa15897981e858757"), + hexstr2bin("92860c21bde06165f8e900c687f8ef0a05d14f290b3f07d8b3a8cc6404366e5d5119cd6d03fb12dc58e89f13df9cd783"), + secp384r1, + hexstr2bin("a23742a2c267d7425fda94b93f93bbcc24791ac51cd8fd501a238d40812f4cbfc59aac9520d758cf789c76300c69d2ff")}, + {ecdh, hexstr2point("00685a48e86c79f0f0875f7bc18d25eb5fc8c0b07e5da4f4370f3a9490340854334b1e1b87fa395464c60626124a4e70d0f785601d37c09870ebf176666877a2046d", "01ba52c56fc8776d9e8f5db4f0cc27636d0b741bbe05400697942e80b739884a83bde99e0f6716939e632bc8986fa18dccd443a348b6c3e522497955a4f3c302f676"), + hexstr2bin("017eecc07ab4b329068fba65e56a1f8890aa935e57134ae0ffcce802735151f4eac6564f6ee9974c5e6887a1fefee5743ae2241bfeb95d5ce31ddcb6f9edb4d6fc47"), + secp521r1, + hexstr2bin("005fc70477c3e63bc3954bd0df3ea0d1f41ee21746ed95fc5e1fdf90930d5e136672d72cc770742d1711c3c3a4c334a0ad9759436a4d3c5bf6e74b9578fac148c831")}, + {ecdh, hexstr2point("01df277c152108349bc34d539ee0cf06b24f5d3500677b4445453ccc21409453aafb8a72a0be9ebe54d12270aa51b3ab7f316aa5e74a951c5e53f74cd95fc29aee7a", "013d52f33a9f3c14384d1587fa8abe7aed74bc33749ad9c570b471776422c7d4505d9b0a96b3bfac041e4c6a6990ae7f700e5b4a6640229112deafa0cd8bb0d089b0"), + hexstr2bin("00816f19c1fb10ef94d4a1d81c156ec3d1de08b66761f03f06ee4bb9dcebbbfe1eaa1ed49a6a990838d8ed318c14d74cc872f95d05d07ad50f621ceb620cd905cfb8"), + secp521r1, + hexstr2bin("000b3920ac830ade812c8f96805da2236e002acbbf13596a9ab254d44d0e91b6255ebf1229f366fb5a05c5884ef46032c26d42189273ca4efa4c3db6bd12a6853759")}, + + %% RFC-6954, Appendix A + {ecdh, hexstr2point("A9C21A569759DA95E0387041184261440327AFE33141CA04B82DC92E", + "98A0F75FBBF61D8E58AE5511B2BCDBE8E549B31E37069A2825F590C1"), + hexstr2bin("6060552303899E2140715816C45B57D9B42204FB6A5BF5BEAC10DB00"), + brainpoolP224r1, + hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")}, + {ecdh, hexstr2point("034A56C550FF88056144E6DD56070F54B0135976B5BF77827313F36B", + "75165AD99347DC86CAAB1CBB579E198EAF88DC35F927B358AA683681"), + hexstr2bin("39F155483CEE191FBECFE9C81D8AB1A03CDA6790E7184ACE44BCA161"), + brainpoolP224r1, + hexstr2bin("1A4BFE705445120C8E3E026699054104510D119757B74D5FE2462C66")}, + {ecdh, hexstr2point("44106E913F92BC02A1705D9953A8414DB95E1AAA49E81D9E85F929A8E3100BE5", + "8AB4846F11CACCB73CE49CBDD120F5A900A69FD32C272223F789EF10EB089BDC"), + hexstr2bin("55E40BC41E37E3E2AD25C3C6654511FFA8474A91A0032087593852D3E7D76BD3"), + brainpoolP256r1, + hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")}, + {ecdh, hexstr2point("8D2D688C6CF93E1160AD04CC4429117DC2C41825E1E9FCA0ADDD34E6F1B39F7B", + "990C57520812BE512641E47034832106BC7D3E8DD0E4C7F1136D7006547CEC6A"), + hexstr2bin("81DB1EE100150FF2EA338D708271BE38300CB54241D79950F77B063039804F1D"), + brainpoolP256r1, + hexstr2bin("89AFC39D41D3B327814B80940B042590F96556EC91E6AE7939BCE31F3A18BF2B")}, + {ecdh, hexstr2point("68B665DD91C195800650CDD363C625F4E742E8134667B767B1B476793588F885AB698C852D4A6E77A252D6380FCAF068", + "55BC91A39C9EC01DEE36017B7D673A931236D2F1F5C83942D049E3FA20607493E0D038FF2FD30C2AB67D15C85F7FAA59"), + hexstr2bin("032640BC6003C59260F7250C3DB58CE647F98E1260ACCE4ACDA3DD869F74E01F8BA5E0324309DB6A9831497ABAC96670"), + brainpoolP384r1, + hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")}, + {ecdh, hexstr2point("4D44326F269A597A5B58BBA565DA5556ED7FD9A8A9EB76C25F46DB69D19DC8CE6AD18E404B15738B2086DF37E71D1EB4", + "62D692136DE56CBE93BF5FA3188EF58BC8A3A0EC6C1E151A21038A42E9185329B5B275903D192F8D4E1F32FE9CC78C48"), + hexstr2bin("1E20F5E048A5886F1F157C74E91BDE2B98C8B52D58E5003D57053FC4B0BD65D6F15EB5D1EE1610DF870795143627D042"), + brainpoolP384r1, + hexstr2bin("0BD9D3A7EA0B3D519D09D8E48D0785FB744A6B355E6304BC51C229FBBCE239BBADF6403715C35D4FB2A5444F575D4F42")}, + {ecdh, hexstr2point("0A420517E406AAC0ACDCE90FCD71487718D3B953EFD7FBEC5F7F27E28C6149999397E91E029E06457DB2D3E640668B392C2A7E737A7F0BF04436D11640FD09FD", + "72E6882E8DB28AAD36237CD25D580DB23783961C8DC52DFA2EC138AD472A0FCEF3887CF62B623B2A87DE5C588301EA3E5FC269B373B60724F5E82A6AD147FDE7"), + hexstr2bin("230E18E1BCC88A362FA54E4EA3902009292F7F8033624FD471B5D8ACE49D12CFABBC19963DAB8E2F1EBA00BFFB29E4D72D13F2224562F405CB80503666B25429"), + brainpoolP512r1, + hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}, + {ecdh, hexstr2point("9D45F66DE5D67E2E6DB6E93A59CE0BB48106097FF78A081DE781CDB31FCE8CCBAAEA8DD4320C4119F1E9CD437A2EAB3731FA9668AB268D871DEDA55A5473199F", + "2FDC313095BCDD5FB3A91636F07A959C8E86B5636A1E930E8396049CB481961D365CC11453A06C719835475B12CB52FC3C383BCE35E27EF194512B71876285FA"), + hexstr2bin("16302FF0DBBB5A8D733DAB7141C1B45ACBC8715939677F6A56850A38BD87BD59B09E80279609FF333EB9D4C061231FB26F92EEB04982A5F1D1764CAD57665422"), + brainpoolP512r1, + hexstr2bin("A7927098655F1F9976FA50A9D566865DC530331846381C87256BAF3226244B76D36403C024D7BBF0AA0803EAFF405D3D24F11A9B5C0BEF679FE1454B21C4CD1F")}], + lists:filter(fun ({_Type, _Pub, _Priv, Curve, _SharedSecret}) -> + lists:member(Curve, Curves) + end, + TestCases). dh() -> {dh, 0087761979513264537414556992123116644042638206717762626089877284926656954974893442000747478454809111207351620687968672207938731607963470779396984752680274820156266685080223616226905101126463253150237669547023934604953898814222890239130021414026118792251620881355456432549881723310342870016961804255746630219, 2}. @@ -2162,18 +2184,24 @@ ecc() -> %% information about the curves see %% http://csrc.nist.gov/encryption/dss/ecdsa/NISTReCur.pdf %% - [{ecdh,secp192r1,1, - hexstr2point("188DA80EB03090F67CBF20EB43A18800F4FF0AFD82FF1012", - "07192B95FFC8DA78631011ED6B24CDD573F977A11E794811")}, - {ecdh,secp192r1,2, - hexstr2point("DAFEBF5828783F2AD35534631588A3F629A70FB16982A888", - "DD6BDA0D993DA0FA46B27BBC141B868F59331AFA5C7E93AB")}, - {ecdh,secp192r1,3, - hexstr2point("76E32A2557599E6EDCD283201FB2B9AADFD0D359CBB263DA", - "782C37E372BA4520AA62E0FED121D49EF3B543660CFD05FD")}, - {ecdh,secp192r1,4, - hexstr2point("35433907297CC378B0015703374729D7A4FE46647084E4BA", - "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")}]. + Curves = crypto:ec_curves(), + TestCases = + [{ecdh,secp192r1,1, + hexstr2point("188DA80EB03090F67CBF20EB43A18800F4FF0AFD82FF1012", + "07192B95FFC8DA78631011ED6B24CDD573F977A11E794811")}, + {ecdh,secp192r1,2, + hexstr2point("DAFEBF5828783F2AD35534631588A3F629A70FB16982A888", + "DD6BDA0D993DA0FA46B27BBC141B868F59331AFA5C7E93AB")}, + {ecdh,secp192r1,3, + hexstr2point("76E32A2557599E6EDCD283201FB2B9AADFD0D359CBB263DA", + "782C37E372BA4520AA62E0FED121D49EF3B543660CFD05FD")}, + {ecdh,secp192r1,4, + hexstr2point("35433907297CC378B0015703374729D7A4FE46647084E4BA", + "A2649984F2135C301EA3ACB0776CD4F125389B311DB3BE32")}], + lists:filter(fun ({_Type, Curve, _Priv, _Pub}) -> + lists:member(Curve, Curves) + end, + TestCases). no_padding() -> Public = [_, Mod] = rsa_public(), diff --git a/lib/crypto/test/old_crypto_SUITE.erl b/lib/crypto/test/old_crypto_SUITE.erl index b5894b070d..1e7f3a1438 100644 --- a/lib/crypto/test/old_crypto_SUITE.erl +++ b/lib/crypto/test/old_crypto_SUITE.erl @@ -1888,48 +1888,12 @@ ec(Config) when is_list(Config) -> ec_do() -> %% test for a name curve - {D2_pub, D2_priv} = crypto:generate_key(ecdh, secp112r2), - PrivECDH = [D2_priv, secp112r2], - PubECDH = [D2_pub, secp112r2], + NamedCurve = hd(crypto:ec_curves()), + {D2_pub, D2_priv} = crypto:generate_key(ecdh, NamedCurve), + PrivECDH = [D2_priv, NamedCurve], + PubECDH = [D2_pub, NamedCurve], %%TODO: find a published test case for a EC key - %% test for a full specified curve and public key, - %% taken from csca-germany_013_self_signed_cer.pem - PubKey = <<16#04, 16#4a, 16#94, 16#49, 16#81, 16#77, 16#9d, 16#df, - 16#1d, 16#a5, 16#e7, 16#c5, 16#27, 16#e2, 16#7d, 16#24, - 16#71, 16#a9, 16#28, 16#eb, 16#4d, 16#7b, 16#67, 16#75, - 16#ae, 16#09, 16#0a, 16#51, 16#45, 16#19, 16#9b, 16#d4, - 16#7e, 16#a0, 16#81, 16#e5, 16#5e, 16#d4, 16#a4, 16#3f, - 16#60, 16#7c, 16#6a, 16#50, 16#ee, 16#36, 16#41, 16#8a, - 16#87, 16#ff, 16#cd, 16#a6, 16#10, 16#39, 16#ca, 16#95, - 16#76, 16#7d, 16#ae, 16#ca, 16#c3, 16#44, 16#3f, 16#e3, 16#2c>>, - <<P:264/integer>> = <<16#00, 16#a9, 16#fb, 16#57, 16#db, 16#a1, 16#ee, 16#a9, - 16#bc, 16#3e, 16#66, 16#0a, 16#90, 16#9d, 16#83, 16#8d, - 16#72, 16#6e, 16#3b, 16#f6, 16#23, 16#d5, 16#26, 16#20, - 16#28, 16#20, 16#13, 16#48, 16#1d, 16#1f, 16#6e, 16#53, 16#77>>, - <<A:256/integer>> = <<16#7d, 16#5a, 16#09, 16#75, 16#fc, 16#2c, 16#30, 16#57, - 16#ee, 16#f6, 16#75, 16#30, 16#41, 16#7a, 16#ff, 16#e7, - 16#fb, 16#80, 16#55, 16#c1, 16#26, 16#dc, 16#5c, 16#6c, - 16#e9, 16#4a, 16#4b, 16#44, 16#f3, 16#30, 16#b5, 16#d9>>, - <<B:256/integer>> = <<16#26, 16#dc, 16#5c, 16#6c, 16#e9, 16#4a, 16#4b, 16#44, - 16#f3, 16#30, 16#b5, 16#d9, 16#bb, 16#d7, 16#7c, 16#bf, - 16#95, 16#84, 16#16, 16#29, 16#5c, 16#f7, 16#e1, 16#ce, - 16#6b, 16#cc, 16#dc, 16#18, 16#ff, 16#8c, 16#07, 16#b6>>, - BasePoint = <<16#04, 16#8b, 16#d2, 16#ae, 16#b9, 16#cb, 16#7e, 16#57, - 16#cb, 16#2c, 16#4b, 16#48, 16#2f, 16#fc, 16#81, 16#b7, - 16#af, 16#b9, 16#de, 16#27, 16#e1, 16#e3, 16#bd, 16#23, - 16#c2, 16#3a, 16#44, 16#53, 16#bd, 16#9a, 16#ce, 16#32, - 16#62, 16#54, 16#7e, 16#f8, 16#35, 16#c3, 16#da, 16#c4, - 16#fd, 16#97, 16#f8, 16#46, 16#1a, 16#14, 16#61, 16#1d, - 16#c9, 16#c2, 16#77, 16#45, 16#13, 16#2d, 16#ed, 16#8e, - 16#54, 16#5c, 16#1d, 16#54, 16#c7, 16#2f, 16#04, 16#69, 16#97>>, - <<Order:264/integer>> = <<16#00, 16#a9, 16#fb, 16#57, 16#db, 16#a1, 16#ee, 16#a9, - 16#bc, 16#3e, 16#66, 16#0a, 16#90, 16#9d, 16#83, 16#8d, - 16#71, 16#8c, 16#39, 16#7a, 16#a3, 16#b5, 16#61, 16#a6, - 16#f7, 16#90, 16#1e, 16#0e, 16#82, 16#97, 16#48, 16#56, 16#a7>>, - CoFactor = 1, - Curve = {{prime_field,P},{A,B,none},BasePoint, Order,CoFactor}, - Msg = <<99,234,6,64,190,237,201,99,80,248,58,40,70,45,149,218,5,246,242,63>>, Sign = crypto:sign(ecdsa, sha, Msg, PrivECDH), ?line true = crypto:verify(ecdsa, sha, Msg, Sign, PubECDH), diff --git a/lib/debugger/src/dbg_icmd.erl b/lib/debugger/src/dbg_icmd.erl index 4c34f253c6..1b274e20ae 100644 --- a/lib/debugger/src/dbg_icmd.erl +++ b/lib/debugger/src/dbg_icmd.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2015. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -267,7 +267,7 @@ handle_int_msg({old_code,Mod}, Status, Bs, #ieval{level=Le,module=M}=Ieval) -> if Status =:= idle, Le =:= 1 -> - erase([Mod|db]), + erase(?DB_REF_KEY(Mod)), put(cache, []); true -> case dbg_istk:in_use_p(Mod, M) of @@ -277,7 +277,7 @@ handle_int_msg({old_code,Mod}, Status, Bs, exit(get(self), kill), dbg_ieval:exception(exit, old_code, Bs, Ieval); false -> - erase([Mod|db]), + erase(?DB_REF_KEY(Mod)), put(cache, []) end end; diff --git a/lib/debugger/src/dbg_ieval.erl b/lib/debugger/src/dbg_ieval.erl index 7ed371a653..f5e079ef7e 100644 --- a/lib/debugger/src/dbg_ieval.erl +++ b/lib/debugger/src/dbg_ieval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2015. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -560,7 +560,7 @@ get_function(Mod, Name, Args, extern) -> end. db_ref(Mod) -> - case get([Mod|db]) of + case get(?DB_REF_KEY(Mod)) of undefined -> case dbg_iserver:call(get(int), {get_module_db, Mod, get(self)}) of @@ -572,7 +572,7 @@ db_ref(Mod) -> Node =/= node() -> {Node,ModDb}; true -> ModDb end, - put([Mod|db], DbRef), + put(?DB_REF_KEY(Mod), DbRef), DbRef end; DbRef -> diff --git a/lib/debugger/src/dbg_ieval.hrl b/lib/debugger/src/dbg_ieval.hrl index 95d0842b19..ad422a9e4a 100644 --- a/lib/debugger/src/dbg_ieval.hrl +++ b/lib/debugger/src/dbg_ieval.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2011. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -27,3 +27,5 @@ %% (i.e. the next call will leave interpreted code). top = false }). + +-define(DB_REF_KEY(Mod), {Mod,db}). diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl index 5fd1519ba0..f9c60f9b72 100644 --- a/lib/debugger/src/dbg_wx_trace.erl +++ b/lib/debugger/src/dbg_wx_trace.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2014. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -811,7 +811,7 @@ gui_show_module(Win, Mod, Line, Mod, _Pid, How) -> dbg_wx_trace_win:mark_line(Win, Line, How); gui_show_module(Win, Mod, Line, _Cm, Pid, How) -> Win2 = case dbg_wx_trace_win:is_shown(Win, Mod) of - {true, Win3} -> Win3; + %% {true, Win3} -> Win3; false -> gui_load_module(Win, Mod, Pid) end, dbg_wx_trace_win:mark_line(Win2, Line, How). diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index c57a22129c..8537878dfc 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -93,31 +93,19 @@ loop(#server_state{parent = Parent} = State, send_log(Parent, LogMsg), loop(State, Analysis, ExtCalls); {AnalPid, warnings, Warnings} -> - case Warnings of - [] -> ok; - SendWarnings -> - send_warnings(Parent, SendWarnings) - end, + send_warnings(Parent, Warnings), loop(State, Analysis, ExtCalls); {AnalPid, cserver, CServer, Plt} -> send_codeserver_plt(Parent, CServer, Plt), loop(State, Analysis, ExtCalls); {AnalPid, done, Plt, DocPlt} -> - case ExtCalls =:= none of - true -> - send_analysis_done(Parent, Plt, DocPlt); - false -> - send_ext_calls(Parent, ExtCalls), - send_analysis_done(Parent, Plt, DocPlt) - end; + send_ext_calls(Parent, ExtCalls), + send_analysis_done(Parent, Plt, DocPlt); {AnalPid, ext_calls, NewExtCalls} -> loop(State, Analysis, NewExtCalls); {AnalPid, ext_types, ExtTypes} -> send_ext_types(Parent, ExtTypes), loop(State, Analysis, ExtCalls); - {AnalPid, unknown_behaviours, UnknownBehaviour} -> - send_unknown_behaviours(Parent, UnknownBehaviour), - loop(State, Analysis, ExtCalls); {AnalPid, mod_deps, ModDeps} -> send_mod_deps(Parent, ModDeps), loop(State, Analysis, ExtCalls); @@ -572,6 +560,8 @@ send_analysis_done(Parent, Plt, DocPlt) -> Parent ! {self(), done, Plt, DocPlt}, ok. +send_ext_calls(_Parent, none) -> + ok; send_ext_calls(Parent, ExtCalls) -> Parent ! {self(), ext_calls, ExtCalls}, ok. @@ -580,10 +570,6 @@ send_ext_types(Parent, ExtTypes) -> Parent ! {self(), ext_types, ExtTypes}, ok. -send_unknown_behaviours(Parent, UnknownBehaviours) -> - Parent ! {self(), unknown_behaviours, UnknownBehaviours}, - ok. - send_codeserver_plt(Parent, CServer, Plt ) -> Parent ! {self(), cserver, CServer, Plt}, ok. @@ -624,6 +610,28 @@ find_call_file_and_line(Tree, MFA) -> MFA -> Ann = cerl:get_ann(SubTree), [{get_file(Ann), get_line(Ann)}|Acc]; + {erlang, make_fun, 3} -> + [CA1, CA2, CA3] = cerl:call_args(SubTree), + case + cerl:is_c_atom(CA1) andalso + cerl:is_c_atom(CA2) andalso + cerl:is_c_int(CA3) + of + true -> + case + {cerl:concrete(CA1), + cerl:concrete(CA2), + cerl:concrete(CA3)} + of + MFA -> + Ann = cerl:get_ann(SubTree), + [{get_file(Ann), get_line(Ann)}|Acc]; + _ -> + Acc + end; + false -> + Acc + end; _ -> Acc end; false -> Acc diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index a1cd2015ca..9e53e171c0 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -478,14 +478,37 @@ scan_one_core_fun(TopTree, FunName) -> call -> CalleeM = cerl:call_module(Tree), CalleeF = cerl:call_name(Tree), - A = length(cerl:call_args(Tree)), + CalleeArgs = cerl:call_args(Tree), + A = length(CalleeArgs), case (cerl:is_c_atom(CalleeM) andalso cerl:is_c_atom(CalleeF)) of true -> M = cerl:atom_val(CalleeM), F = cerl:atom_val(CalleeF), case erl_bif_types:is_known(M, F, A) of - true -> Acc; + true -> + case {M, F, A} of + {erlang, make_fun, 3} -> + [CA1, CA2, CA3] = CalleeArgs, + case + cerl:is_c_atom(CA1) andalso + cerl:is_c_atom(CA2) andalso + cerl:is_c_int(CA3) + of + true -> + MM = cerl:atom_val(CA1), + FF = cerl:atom_val(CA2), + AA = cerl:int_val(CA3), + case erl_bif_types:is_known(MM, FF, AA) of + true -> Acc; + false -> [{FunName, {MM, FF, AA}}|Acc] + end; + false -> + Acc + end; + _ -> + Acc + end; false -> [{FunName, {M, F, A}}|Acc] end; false -> diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 4116866916..9354b8007e 100644 --- a/lib/dialyzer/src/dialyzer_cl.erl +++ b/lib/dialyzer/src/dialyzer_cl.erl @@ -49,8 +49,7 @@ plt_info = none :: 'none' | dialyzer_plt:plt_info(), report_mode = normal :: rep_mode(), return_status= ?RET_NOTHING_SUSPICIOUS :: dial_ret(), - stored_warnings = [] :: [raw_warning()], - unknown_behaviours = [] :: [dialyzer_behaviours:behaviour()] + stored_warnings = [] :: [raw_warning()] }). %%-------------------------------------------------------------------- @@ -638,9 +637,6 @@ cl_loop(State, LogCache) -> {BackendPid, warnings, Warnings} -> NewState = store_warnings(State, Warnings), cl_loop(NewState, LogCache); - {BackendPid, unknown_behaviours, Behaviours} -> - NewState = store_unknown_behaviours(State, Behaviours), - cl_loop(NewState, LogCache); {BackendPid, done, NewPlt, _NewDocPlt} -> return_value(State, NewPlt); {BackendPid, ext_calls, ExtCalls} -> @@ -683,11 +679,6 @@ format_log_cache(LogCache) -> store_warnings(#cl_state{stored_warnings = StoredWarnings} = St, Warnings) -> St#cl_state{stored_warnings = StoredWarnings ++ Warnings}. --spec store_unknown_behaviours(#cl_state{}, [dialyzer_behaviours:behaviour()]) -> #cl_state{}. - -store_unknown_behaviours(#cl_state{unknown_behaviours = Behs} = St, Beh) -> - St#cl_state{unknown_behaviours = Beh ++ Behs}. - -spec cl_error(string()) -> no_return(). cl_error(Msg) -> @@ -724,7 +715,6 @@ return_value(State = #cl_state{erlang_mode = ErlangMode, print_warnings(State), print_ext_calls(State), print_ext_types(State), - print_unknown_behaviours(State), maybe_close_output_file(State), {RetValue, []}; true -> @@ -737,8 +727,7 @@ unknown_warnings(State = #cl_state{legal_warnings = LegalWarnings}) -> Unknown = case ordsets:is_element(?WARN_UNKNOWN, LegalWarnings) of true -> unknown_functions(State) ++ - unknown_types(State) ++ - unknown_behaviours(State); + unknown_types(State); false -> [] end, WarningInfo = {_Filename = "", _Line = 0, _MorMFA = ''}, @@ -814,48 +803,6 @@ do_print_ext_types(Output, [{M,F,A}|T], Before) -> do_print_ext_types(_, [], _) -> ok. -unknown_behaviours(#cl_state{unknown_behaviours = DupBehaviours, - legal_warnings = LegalWarnings}) -> - case ordsets:is_element(?WARN_BEHAVIOUR, LegalWarnings) of - false -> []; - true -> - Behaviours = lists:usort(DupBehaviours), - [{unknown_behaviour, B} || B <- Behaviours] - end. - -%%print_unknown_behaviours(#cl_state{report_mode = quiet}) -> -%% ok; -print_unknown_behaviours(#cl_state{output = Output, - external_calls = Calls, - external_types = Types, - stored_warnings = Warnings, - unknown_behaviours = DupBehaviours, - legal_warnings = LegalWarnings, - output_format = Format}) -> - case ordsets:is_element(?WARN_BEHAVIOUR, LegalWarnings) - andalso DupBehaviours =/= [] of - false -> ok; - true -> - Behaviours = lists:usort(DupBehaviours), - case Warnings =:= [] andalso Calls =:= [] andalso Types =:= [] of - true -> io:nl(Output); %% Need to do a newline first - false -> ok - end, - {Prompt, Prefix} = - case Format of - formatted -> {"Unknown behaviours:\n"," "}; - raw -> {"%% Unknown behaviours:\n","%% "} - end, - io:put_chars(Output, Prompt), - do_print_unknown_behaviours(Output, Behaviours, Prefix) - end. - -do_print_unknown_behaviours(Output, [B|T], Before) -> - io:format(Output, "~s~p\n", [Before,B]), - do_print_unknown_behaviours(Output, T, Before); -do_print_unknown_behaviours(_, [], _) -> - ok. - print_warnings(#cl_state{stored_warnings = []}) -> ok; print_warnings(#cl_state{output = Output, diff --git a/lib/dialyzer/src/dialyzer_options.erl b/lib/dialyzer/src/dialyzer_options.erl index ce84c17f43..dd81dd01ed 100644 --- a/lib/dialyzer/src/dialyzer_options.erl +++ b/lib/dialyzer/src/dialyzer_options.erl @@ -72,9 +72,15 @@ preprocess_opts([Opt|Opts]) -> [Opt|preprocess_opts(Opts)]. postprocess_opts(Opts = #options{}) -> + check_file_existence(Opts), Opts1 = check_output_plt(Opts), adapt_get_warnings(Opts1). +check_file_existence(#options{analysis_type = plt_remove}) -> ok; +check_file_existence(#options{files = Files, files_rec = FilesRec}) -> + assert_filenames_exist(Files), + assert_filenames_exist(FilesRec). + check_output_plt(Opts = #options{analysis_type = Mode, from = From, output_plt = OutPLT}) -> case is_plt_mode(Mode) of @@ -126,14 +132,14 @@ build_options([{OptionName, Value} = Term|Rest], Options) -> apps -> OldValues = Options#options.files_rec, AppDirs = get_app_dirs(Value), - assert_filenames(Term, AppDirs), + assert_filenames_form(Term, AppDirs), build_options(Rest, Options#options{files_rec = AppDirs ++ OldValues}); files -> - assert_filenames(Term, Value), + assert_filenames_form(Term, Value), build_options(Rest, Options#options{files = Value}); files_rec -> OldValues = Options#options.files_rec, - assert_filenames(Term, Value), + assert_filenames_form(Term, Value), build_options(Rest, Options#options{files_rec = Value ++ OldValues}); analysis_type -> NewOptions = @@ -210,16 +216,26 @@ get_app_dirs(Apps) when is_list(Apps) -> get_app_dirs(Apps) -> bad_option("Use a list of otp applications", Apps). -assert_filenames(Term, [FileName|Left]) when length(FileName) >= 0 -> +assert_filenames(Term, Files) -> + assert_filenames_form(Term, Files), + assert_filenames_exist(Files). + +assert_filenames_form(Term, [FileName|Left]) when length(FileName) >= 0 -> + assert_filenames_form(Term, Left); +assert_filenames_form(_Term, []) -> + ok; +assert_filenames_form(Term, [_|_]) -> + bad_option("Malformed or non-existing filename", Term). + +assert_filenames_exist([FileName|Left]) -> case filelib:is_file(FileName) orelse filelib:is_dir(FileName) of true -> ok; - false -> bad_option("No such file, directory or application", FileName) + false -> + bad_option("No such file, directory or application", FileName) end, - assert_filenames(Term, Left); -assert_filenames(_Term, []) -> - ok; -assert_filenames(Term, [_|_]) -> - bad_option("Malformed or non-existing filename", Term). + assert_filenames_exist(Left); +assert_filenames_exist([]) -> + ok. assert_filename(FileName) when length(FileName) >= 0 -> ok; diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index 634871b2eb..769f26a3df 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -137,7 +137,7 @@ delete_list(#plt{info = Info, types = Types, #plt{info = table_delete_list(Info, List), types = Types, contracts = table_delete_list(Contracts, List), - callbacks = table_delete_list(Callbacks, List), + callbacks = Callbacks, exported_types = ExpTypes}. -spec insert_contract_list(plt(), dialyzer_contracts:plt_contracts()) -> plt(). diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl index ecbac14e5d..6ebe23b54b 100644 --- a/lib/dialyzer/test/plt_SUITE.erl +++ b/lib/dialyzer/test/plt_SUITE.erl @@ -7,12 +7,14 @@ -include("dialyzer_test_constants.hrl"). -export([suite/0, all/0, build_plt/1, beam_tests/1, update_plt/1, - run_plt_check/1, run_succ_typings/1]). + local_fun_same_as_callback/1, + remove_plt/1, run_plt_check/1, run_succ_typings/1]). suite() -> [{timetrap, ?plt_timeout}]. -all() -> [build_plt, beam_tests, update_plt, run_plt_check, run_succ_typings]. +all() -> [build_plt, beam_tests, update_plt, run_plt_check, + remove_plt, run_succ_typings, local_fun_same_as_callback]. build_plt(Config) -> OutDir = ?config(priv_dir, Config), @@ -158,6 +160,95 @@ update_plt(Config) -> {init_plt, Plt}] ++ Opts), ok. +%%% If a behaviour module contains an non-exported function with the same name +%%% as one of the behaviour's callbacks, the callback info was inadvertently +%%% deleted from the PLT as the dialyzer_plt:delete_list/2 function was cleaning +%%% up the callback table. This bug was reported by Brujo Benavides. + +local_fun_same_as_callback(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + Prog1 = + <<"-module(bad_behaviour). + -callback bad() -> bad. + -export([publicly_bad/0]). + + %% @doc This function is here just to avoid the 'unused' warning for bad/0 + publicly_bad() -> bad(). + + %% @doc This function overlaps with the callback with the same name, and + %% that was an issue for dialyzer since it's a private function. + bad() -> bad.">>, + {ok, Beam} = compile(Config, Prog1, bad_behaviour, []), + + ErlangBeam = case code:where_is_file("erlang.beam") of + non_existing -> + filename:join([code:root_dir(), + "erts", "preloaded", "ebin", + "erlang.beam"]); + EBeam -> + EBeam + end, + Plt = filename:join(PrivDir, "plt_bad_behaviour.plt"), + Opts = [{check_plt, true}, {from, byte_code}], + [] = dialyzer:run([{analysis_type, plt_build}, + {files, [Beam, ErlangBeam]}, + {output_plt, Plt}] ++ Opts), + + Prog2 = + <<"-module(bad_child). + -behaviour(bad_behaviour). + + -export([bad/0]). + + %% @doc This function incorreclty implements bad_behaviour. + bad() -> not_bad.">>, + {ok, TestBeam} = compile(Config, Prog2, bad_child, []), + + [{warn_behaviour, _, + {callback_type_mismatch, + [bad_behaviour,bad,0,"'not_bad'","'bad'"]}}] = + dialyzer:run([{analysis_type, succ_typings}, + {files, [TestBeam]}, + {init_plt, Plt}] ++ Opts), + ok. + +%%% [James Fish:] +%%% Dialyzer always asserts that files and directories passed in its +%%% options exist. Therefore it is not possible to remove a beam/module +%%% from a PLT when the beam file no longer exists. Dialyzer should not to +%%% check files exist on disk when removing from the PLT. +remove_plt(Config) -> + PrivDir = ?config(priv_dir, Config), + Prog1 = <<"-module(m1). + -export([t/0]). + t() -> + m2:a(a).">>, + {ok, Beam1} = compile(Config, Prog1, m1, []), + + Prog2 = <<"-module(m2). + -export([a/1]). + a(A) when is_integer(A) -> A.">>, + {ok, Beam2} = compile(Config, Prog2, m2, []), + + Plt = filename:join(PrivDir, "remove.plt"), + Opts = [{check_plt, true}, {from, byte_code}], + + [{warn_return_no_exit, _, {no_return,[only_normal,t,0]}}, + {warn_failing_call, _, {call, [m2,a,"('a')",_,_,_,_,_]}}] = + dialyzer:run([{analysis_type, plt_build}, + {files, [Beam1, Beam2]}, + {get_warnings, true}, + {output_plt, Plt}] ++ Opts), + + [] = dialyzer:run([{init_plt, Plt}, + {files, [Beam2]}, + {analysis_type, plt_remove}]), + + [] = dialyzer:run([{analysis_type, succ_typings}, + {files, [Beam1]}, + {init_plt, Plt}] ++ Opts), + ok. + compile(Config, Prog, Module, CompileOpts) -> Source = lists:concat([Module, ".erl"]), PrivDir = ?config(priv_dir,Config), diff --git a/lib/dialyzer/test/small_SUITE_data/results/comparisons b/lib/dialyzer/test/small_SUITE_data/results/comparisons index 642585d25e..5083d2695a 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/comparisons +++ b/lib/dialyzer/test/small_SUITE_data/results/comparisons @@ -1,50 +1,43 @@ comparisons.erl:100: The pattern 'true' can never match the type 'false' -comparisons.erl:101: The pattern 'true' can never match the type 'false' +comparisons.erl:101: The pattern 'false' can never match the type 'true' comparisons.erl:102: The pattern 'false' can never match the type 'true' -comparisons.erl:103: The pattern 'false' can never match the type 'true' +comparisons.erl:103: The pattern 'true' can never match the type 'false' comparisons.erl:104: The pattern 'true' can never match the type 'false' -comparisons.erl:105: The pattern 'true' can never match the type 'false' -comparisons.erl:107: The pattern 'true' can never match the type 'false' -comparisons.erl:108: The pattern 'true' can never match the type 'false' -comparisons.erl:109: The pattern 'false' can never match the type 'true' -comparisons.erl:110: The pattern 'false' can never match the type 'true' -comparisons.erl:111: The pattern 'true' can never match the type 'false' -comparisons.erl:112: The pattern 'true' can never match the type 'false' -comparisons.erl:113: The pattern 'false' can never match the type 'true' -comparisons.erl:114: The pattern 'false' can never match the type 'true' -comparisons.erl:115: The pattern 'true' can never match the type 'false' -comparisons.erl:116: The pattern 'true' can never match the type 'false' -comparisons.erl:117: The pattern 'false' can never match the type 'true' comparisons.erl:118: The pattern 'false' can never match the type 'true' +comparisons.erl:119: The pattern 'false' can never match the type 'true' +comparisons.erl:120: The pattern 'true' can never match the type 'false' +comparisons.erl:121: The pattern 'true' can never match the type 'false' +comparisons.erl:122: The pattern 'false' can never match the type 'true' comparisons.erl:123: The pattern 'false' can never match the type 'true' -comparisons.erl:124: The pattern 'false' can never match the type 'true' +comparisons.erl:124: The pattern 'true' can never match the type 'false' comparisons.erl:125: The pattern 'true' can never match the type 'false' -comparisons.erl:126: The pattern 'true' can never match the type 'false' +comparisons.erl:126: The pattern 'false' can never match the type 'true' comparisons.erl:127: The pattern 'false' can never match the type 'true' -comparisons.erl:128: The pattern 'false' can never match the type 'true' +comparisons.erl:128: The pattern 'true' can never match the type 'false' comparisons.erl:129: The pattern 'true' can never match the type 'false' -comparisons.erl:130: The pattern 'true' can never match the type 'false' +comparisons.erl:130: The pattern 'false' can never match the type 'true' +comparisons.erl:131: The pattern 'false' can never match the type 'true' comparisons.erl:132: The pattern 'true' can never match the type 'false' comparisons.erl:133: The pattern 'true' can never match the type 'false' comparisons.erl:134: The pattern 'false' can never match the type 'true' comparisons.erl:135: The pattern 'false' can never match the type 'true' comparisons.erl:136: The pattern 'true' can never match the type 'false' comparisons.erl:137: The pattern 'true' can never match the type 'false' -comparisons.erl:138: The pattern 'false' can never match the type 'true' -comparisons.erl:139: The pattern 'false' can never match the type 'true' +comparisons.erl:139: The pattern 'true' can never match the type 'false' comparisons.erl:140: The pattern 'true' can never match the type 'false' -comparisons.erl:141: The pattern 'true' can never match the type 'false' +comparisons.erl:141: The pattern 'false' can never match the type 'true' comparisons.erl:142: The pattern 'false' can never match the type 'true' -comparisons.erl:143: The pattern 'false' can never match the type 'true' +comparisons.erl:143: The pattern 'true' can never match the type 'false' comparisons.erl:144: The pattern 'true' can never match the type 'false' -comparisons.erl:145: The pattern 'true' can never match the type 'false' +comparisons.erl:145: The pattern 'false' can never match the type 'true' comparisons.erl:146: The pattern 'false' can never match the type 'true' -comparisons.erl:147: The pattern 'false' can never match the type 'true' -comparisons.erl:152: The pattern 'false' can never match the type 'true' -comparisons.erl:153: The pattern 'false' can never match the type 'true' -comparisons.erl:154: The pattern 'true' can never match the type 'false' -comparisons.erl:155: The pattern 'true' can never match the type 'false' +comparisons.erl:147: The pattern 'true' can never match the type 'false' +comparisons.erl:148: The pattern 'true' can never match the type 'false' +comparisons.erl:149: The pattern 'false' can never match the type 'true' +comparisons.erl:150: The pattern 'false' can never match the type 'true' +comparisons.erl:155: The pattern 'false' can never match the type 'true' +comparisons.erl:156: The pattern 'false' can never match the type 'true' comparisons.erl:157: The pattern 'true' can never match the type 'false' comparisons.erl:158: The pattern 'true' can never match the type 'false' comparisons.erl:159: The pattern 'false' can never match the type 'true' @@ -59,36 +52,62 @@ comparisons.erl:167: The pattern 'false' can never match the type 'true' comparisons.erl:168: The pattern 'false' can never match the type 'true' comparisons.erl:169: The pattern 'true' can never match the type 'false' comparisons.erl:170: The pattern 'true' can never match the type 'false' -comparisons.erl:171: The pattern 'false' can never match the type 'true' -comparisons.erl:172: The pattern 'false' can never match the type 'true' +comparisons.erl:172: The pattern 'true' can never match the type 'false' comparisons.erl:173: The pattern 'true' can never match the type 'false' -comparisons.erl:174: The pattern 'true' can never match the type 'false' +comparisons.erl:174: The pattern 'false' can never match the type 'true' comparisons.erl:175: The pattern 'false' can never match the type 'true' -comparisons.erl:176: The pattern 'false' can never match the type 'true' +comparisons.erl:176: The pattern 'true' can never match the type 'false' +comparisons.erl:177: The pattern 'true' can never match the type 'false' +comparisons.erl:178: The pattern 'false' can never match the type 'true' +comparisons.erl:179: The pattern 'false' can never match the type 'true' +comparisons.erl:180: The pattern 'true' can never match the type 'false' +comparisons.erl:181: The pattern 'true' can never match the type 'false' +comparisons.erl:182: The pattern 'false' can never match the type 'true' +comparisons.erl:183: The pattern 'false' can never match the type 'true' +comparisons.erl:184: The pattern 'true' can never match the type 'false' +comparisons.erl:185: The pattern 'true' can never match the type 'false' comparisons.erl:186: The pattern 'false' can never match the type 'true' comparisons.erl:187: The pattern 'false' can never match the type 'true' -comparisons.erl:188: The pattern 'true' can never match the type 'false' -comparisons.erl:189: The pattern 'true' can never match the type 'false' -comparisons.erl:190: The pattern 'false' can never match the type 'true' -comparisons.erl:191: The pattern 'false' can never match the type 'true' -comparisons.erl:192: The pattern 'true' can never match the type 'false' -comparisons.erl:193: The pattern 'true' can never match the type 'false' -comparisons.erl:203: The pattern 'false' can never match the type 'true' -comparisons.erl:204: The pattern 'false' can never match the type 'true' +comparisons.erl:192: The pattern 'false' can never match the type 'true' +comparisons.erl:193: The pattern 'false' can never match the type 'true' +comparisons.erl:194: The pattern 'true' can never match the type 'false' +comparisons.erl:195: The pattern 'true' can never match the type 'false' +comparisons.erl:196: The pattern 'false' can never match the type 'true' +comparisons.erl:197: The pattern 'false' can never match the type 'true' +comparisons.erl:198: The pattern 'true' can never match the type 'false' +comparisons.erl:199: The pattern 'true' can never match the type 'false' +comparisons.erl:200: The pattern 'false' can never match the type 'true' +comparisons.erl:201: The pattern 'false' can never match the type 'true' +comparisons.erl:202: The pattern 'true' can never match the type 'false' +comparisons.erl:203: The pattern 'true' can never match the type 'false' comparisons.erl:205: The pattern 'true' can never match the type 'false' comparisons.erl:206: The pattern 'true' can never match the type 'false' -comparisons.erl:208: The pattern 'true' can never match the type 'false' +comparisons.erl:207: The pattern 'false' can never match the type 'true' +comparisons.erl:208: The pattern 'false' can never match the type 'true' comparisons.erl:209: The pattern 'true' can never match the type 'false' -comparisons.erl:210: The pattern 'false' can never match the type 'true' +comparisons.erl:210: The pattern 'true' can never match the type 'false' comparisons.erl:211: The pattern 'false' can never match the type 'true' +comparisons.erl:212: The pattern 'false' can never match the type 'true' +comparisons.erl:213: The pattern 'true' can never match the type 'false' +comparisons.erl:214: The pattern 'true' can never match the type 'false' +comparisons.erl:215: The pattern 'false' can never match the type 'true' +comparisons.erl:216: The pattern 'false' can never match the type 'true' +comparisons.erl:217: The pattern 'true' can never match the type 'false' +comparisons.erl:218: The pattern 'true' can never match the type 'false' +comparisons.erl:219: The pattern 'false' can never match the type 'true' +comparisons.erl:220: The pattern 'false' can never match the type 'true' comparisons.erl:221: The pattern 'true' can never match the type 'false' comparisons.erl:222: The pattern 'true' can never match the type 'false' comparisons.erl:223: The pattern 'false' can never match the type 'true' comparisons.erl:224: The pattern 'false' can never match the type 'true' -comparisons.erl:225: The pattern 'true' can never match the type 'false' -comparisons.erl:226: The pattern 'true' can never match the type 'false' -comparisons.erl:227: The pattern 'false' can never match the type 'true' -comparisons.erl:228: The pattern 'false' can never match the type 'true' +comparisons.erl:229: The pattern 'true' can never match the type 'false' +comparisons.erl:230: The pattern 'true' can never match the type 'false' +comparisons.erl:231: The pattern 'false' can never match the type 'true' +comparisons.erl:232: The pattern 'false' can never match the type 'true' +comparisons.erl:233: The pattern 'false' can never match the type 'true' +comparisons.erl:234: The pattern 'false' can never match the type 'true' +comparisons.erl:235: The pattern 'true' can never match the type 'false' +comparisons.erl:236: The pattern 'true' can never match the type 'false' comparisons.erl:242: The pattern 'false' can never match the type 'true' comparisons.erl:243: The pattern 'false' can never match the type 'true' comparisons.erl:244: The pattern 'true' can never match the type 'false' @@ -97,57 +116,86 @@ comparisons.erl:246: The pattern 'false' can never match the type 'true' comparisons.erl:247: The pattern 'false' can never match the type 'true' comparisons.erl:248: The pattern 'true' can never match the type 'false' comparisons.erl:249: The pattern 'true' can never match the type 'false' -comparisons.erl:251: The pattern 'true' can never match the type 'false' -comparisons.erl:252: The pattern 'true' can never match the type 'false' -comparisons.erl:253: The pattern 'false' can never match the type 'true' -comparisons.erl:254: The pattern 'false' can never match the type 'true' -comparisons.erl:263: The pattern 'false' can never match the type 'true' -comparisons.erl:264: The pattern 'false' can never match the type 'true' +comparisons.erl:259: The pattern 'false' can never match the type 'true' +comparisons.erl:260: The pattern 'false' can never match the type 'true' +comparisons.erl:261: The pattern 'true' can never match the type 'false' +comparisons.erl:262: The pattern 'true' can never match the type 'false' +comparisons.erl:264: The pattern 'true' can never match the type 'false' comparisons.erl:265: The pattern 'true' can never match the type 'false' -comparisons.erl:266: The pattern 'true' can never match the type 'false' -comparisons.erl:268: The pattern 'true' can never match the type 'false' -comparisons.erl:269: The pattern 'true' can never match the type 'false' -comparisons.erl:270: The pattern 'false' can never match the type 'true' -comparisons.erl:271: The pattern 'false' can never match the type 'true' -comparisons.erl:272: The pattern 'true' can never match the type 'false' -comparisons.erl:273: The pattern 'true' can never match the type 'false' -comparisons.erl:274: The pattern 'false' can never match the type 'true' -comparisons.erl:275: The pattern 'false' can never match the type 'true' -comparisons.erl:293: The pattern 'false' can never match the type 'true' -comparisons.erl:294: The pattern 'false' can never match the type 'true' -comparisons.erl:295: The pattern 'true' can never match the type 'false' -comparisons.erl:296: The pattern 'true' can never match the type 'false' -comparisons.erl:311: The pattern 'true' can never match the type 'false' -comparisons.erl:312: The pattern 'true' can never match the type 'false' -comparisons.erl:313: The pattern 'false' can never match the type 'true' -comparisons.erl:314: The pattern 'false' can never match the type 'true' -comparisons.erl:44: The pattern 'false' can never match the type 'true' -comparisons.erl:45: The pattern 'false' can never match the type 'true' -comparisons.erl:46: The pattern 'true' can never match the type 'false' -comparisons.erl:47: The pattern 'true' can never match the type 'false' -comparisons.erl:48: The pattern 'false' can never match the type 'true' -comparisons.erl:49: The pattern 'false' can never match the type 'true' -comparisons.erl:50: The pattern 'true' can never match the type 'false' -comparisons.erl:51: The pattern 'true' can never match the type 'false' +comparisons.erl:266: The pattern 'false' can never match the type 'true' +comparisons.erl:267: The pattern 'false' can never match the type 'true' +comparisons.erl:277: The pattern 'true' can never match the type 'false' +comparisons.erl:278: The pattern 'true' can never match the type 'false' +comparisons.erl:279: The pattern 'false' can never match the type 'true' +comparisons.erl:280: The pattern 'false' can never match the type 'true' +comparisons.erl:281: The pattern 'true' can never match the type 'false' +comparisons.erl:282: The pattern 'true' can never match the type 'false' +comparisons.erl:283: The pattern 'false' can never match the type 'true' +comparisons.erl:284: The pattern 'false' can never match the type 'true' +comparisons.erl:298: The pattern 'false' can never match the type 'true' +comparisons.erl:299: The pattern 'false' can never match the type 'true' +comparisons.erl:300: The pattern 'true' can never match the type 'false' +comparisons.erl:301: The pattern 'true' can never match the type 'false' +comparisons.erl:302: The pattern 'false' can never match the type 'true' +comparisons.erl:303: The pattern 'false' can never match the type 'true' +comparisons.erl:304: The pattern 'true' can never match the type 'false' +comparisons.erl:305: The pattern 'true' can never match the type 'false' +comparisons.erl:307: The pattern 'true' can never match the type 'false' +comparisons.erl:308: The pattern 'true' can never match the type 'false' +comparisons.erl:309: The pattern 'false' can never match the type 'true' +comparisons.erl:310: The pattern 'false' can never match the type 'true' +comparisons.erl:319: The pattern 'false' can never match the type 'true' +comparisons.erl:320: The pattern 'false' can never match the type 'true' +comparisons.erl:321: The pattern 'true' can never match the type 'false' +comparisons.erl:322: The pattern 'true' can never match the type 'false' +comparisons.erl:324: The pattern 'true' can never match the type 'false' +comparisons.erl:325: The pattern 'true' can never match the type 'false' +comparisons.erl:326: The pattern 'false' can never match the type 'true' +comparisons.erl:327: The pattern 'false' can never match the type 'true' +comparisons.erl:328: The pattern 'true' can never match the type 'false' +comparisons.erl:329: The pattern 'true' can never match the type 'false' +comparisons.erl:330: The pattern 'false' can never match the type 'true' +comparisons.erl:331: The pattern 'false' can never match the type 'true' +comparisons.erl:349: The pattern 'false' can never match the type 'true' +comparisons.erl:350: The pattern 'false' can never match the type 'true' +comparisons.erl:351: The pattern 'true' can never match the type 'false' +comparisons.erl:352: The pattern 'true' can never match the type 'false' +comparisons.erl:367: The pattern 'true' can never match the type 'false' +comparisons.erl:368: The pattern 'true' can never match the type 'false' +comparisons.erl:369: The pattern 'false' can never match the type 'true' +comparisons.erl:370: The pattern 'false' can never match the type 'true' comparisons.erl:52: The pattern 'false' can never match the type 'true' comparisons.erl:53: The pattern 'false' can never match the type 'true' comparisons.erl:54: The pattern 'true' can never match the type 'false' comparisons.erl:55: The pattern 'true' can never match the type 'false' +comparisons.erl:56: The pattern 'false' can never match the type 'true' +comparisons.erl:57: The pattern 'false' can never match the type 'true' +comparisons.erl:58: The pattern 'true' can never match the type 'false' +comparisons.erl:59: The pattern 'true' can never match the type 'false' +comparisons.erl:60: The pattern 'false' can never match the type 'true' +comparisons.erl:61: The pattern 'false' can never match the type 'true' +comparisons.erl:62: The pattern 'true' can never match the type 'false' +comparisons.erl:63: The pattern 'true' can never match the type 'false' +comparisons.erl:64: The pattern 'false' can never match the type 'true' +comparisons.erl:65: The pattern 'false' can never match the type 'true' +comparisons.erl:66: The pattern 'true' can never match the type 'false' +comparisons.erl:67: The pattern 'true' can never match the type 'false' +comparisons.erl:68: The pattern 'false' can never match the type 'true' comparisons.erl:69: The pattern 'false' can never match the type 'true' -comparisons.erl:70: The pattern 'false' can never match the type 'true' +comparisons.erl:70: The pattern 'true' can never match the type 'false' comparisons.erl:71: The pattern 'true' can never match the type 'false' -comparisons.erl:72: The pattern 'true' can never match the type 'false' -comparisons.erl:73: The pattern 'false' can never match the type 'true' -comparisons.erl:74: The pattern 'false' can never match the type 'true' -comparisons.erl:75: The pattern 'true' can never match the type 'false' -comparisons.erl:76: The pattern 'true' can never match the type 'false' -comparisons.erl:77: The pattern 'false' can never match the type 'true' -comparisons.erl:78: The pattern 'false' can never match the type 'true' -comparisons.erl:79: The pattern 'true' can never match the type 'false' -comparisons.erl:80: The pattern 'true' can never match the type 'false' +comparisons.erl:85: The pattern 'false' can never match the type 'true' +comparisons.erl:86: The pattern 'false' can never match the type 'true' +comparisons.erl:87: The pattern 'true' can never match the type 'false' +comparisons.erl:88: The pattern 'true' can never match the type 'false' +comparisons.erl:89: The pattern 'false' can never match the type 'true' +comparisons.erl:90: The pattern 'false' can never match the type 'true' +comparisons.erl:91: The pattern 'true' can never match the type 'false' +comparisons.erl:92: The pattern 'true' can never match the type 'false' +comparisons.erl:93: The pattern 'false' can never match the type 'true' comparisons.erl:94: The pattern 'false' can never match the type 'true' -comparisons.erl:95: The pattern 'false' can never match the type 'true' +comparisons.erl:95: The pattern 'true' can never match the type 'false' comparisons.erl:96: The pattern 'true' can never match the type 'false' -comparisons.erl:97: The pattern 'true' can never match the type 'false' +comparisons.erl:97: The pattern 'false' can never match the type 'true' comparisons.erl:98: The pattern 'false' can never match the type 'true' -comparisons.erl:99: The pattern 'false' can never match the type 'true' +comparisons.erl:99: The pattern 'true' can never match the type 'false' diff --git a/lib/dialyzer/test/small_SUITE_data/results/fun_arity b/lib/dialyzer/test/small_SUITE_data/results/fun_arity index 280f5490d0..cc9db65152 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/fun_arity +++ b/lib/dialyzer/test/small_SUITE_data/results/fun_arity @@ -31,5 +31,7 @@ fun_arity.erl:81: Function mfa_ne_1_ko/0 has no local return fun_arity.erl:83: Function mf_ne/1 will never be called fun_arity.erl:89: Fun application will fail since _cor0 :: fun(() -> any()) is not a function of arity 1 fun_arity.erl:89: Function mfa_nd_0_ko/0 has no local return +fun_arity.erl:90: Call to missing or unexported function fun_arity:mf_nd/0 fun_arity.erl:93: Fun application will fail since _cor0 :: fun((_) -> any()) is not a function of arity 0 fun_arity.erl:93: Function mfa_nd_1_ko/0 has no local return +fun_arity.erl:94: Call to missing or unexported function fun_arity:mf_nd/1 diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps1 b/lib/dialyzer/test/small_SUITE_data/results/maps1 new file mode 100644 index 0000000000..5a78d66a92 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/results/maps1 @@ -0,0 +1,4 @@ + +maps1.erl:43: Function t3/0 has no local return +maps1.erl:44: The call maps1:foo(~{'greger'=>3, ~{'arne'=>'anka'}~=>45}~,1) will never return since it differs in the 2nd argument from the success typing arguments: (#{},'b') +maps1.erl:52: The call Mod:'function'(~{'literal'=>'map'}~,'another_arg') requires that Mod is of type atom() | tuple() not #{} diff --git a/lib/dialyzer/test/small_SUITE_data/results/non_existing b/lib/dialyzer/test/small_SUITE_data/results/non_existing index 58da2bfc8b..b0da5998c7 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/non_existing +++ b/lib/dialyzer/test/small_SUITE_data/results/non_existing @@ -1,2 +1,3 @@ +non_existing.erl:12: Call to missing or unexported function lists:non_existing_fun/1 non_existing.erl:9: Call to missing or unexported function lists:non_existing_call/1 diff --git a/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl b/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl index 70e3cb6af4..64927c6c91 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/comparisons.erl @@ -19,12 +19,20 @@ tuple(X) when is_tuple(X) -> X. list() -> list(?r). list(X) when is_list(X) -> X. +map() -> map(?r). +map(X) when is_map(X) -> #{}. + +bitstring() -> bitstring(?r). +bitstring(X) when is_bitstring(X) -> <<0:63>>. + i() -> integer(). f() -> mfloat(). n() -> case ?r of 1 -> i(); 2 -> f() end. a() -> atom(). t() -> tuple(). l() -> list(). +m() -> map(). +b() -> bitstring(). na() -> case ?r of 1 -> n(); 2 -> a() end. at() -> case ?r of 1 -> t(); 2 -> a() end. tl() -> case ?r of 1 -> t(); 2 -> l() end. @@ -53,6 +61,14 @@ test_i_ll_l() -> case i() < l() of true -> always; false -> never end. test_i_le_l() -> case i() =< l() of true -> always; false -> never end. test_i_gg_l() -> case i() > l() of true -> never; false -> always end. test_i_ge_l() -> case i() >= l() of true -> never; false -> always end. +test_i_ll_m() -> case i() < m() of true -> always; false -> never end. +test_i_le_m() -> case i() =< m() of true -> always; false -> never end. +test_i_gg_m() -> case i() > m() of true -> never; false -> always end. +test_i_ge_m() -> case i() >= m() of true -> never; false -> always end. +test_i_ll_b() -> case i() < b() of true -> always; false -> never end. +test_i_le_b() -> case i() =< b() of true -> always; false -> never end. +test_i_gg_b() -> case i() > b() of true -> never; false -> always end. +test_i_ge_b() -> case i() >= b() of true -> never; false -> always end. test_f_ll_i() -> case f() < i() of true -> maybe; false -> maybe_too end. test_f_le_i() -> case f() =< i() of true -> maybe; false -> maybe_too end. @@ -78,6 +94,14 @@ test_f_ll_l() -> case f() < l() of true -> always; false -> never end. test_f_le_l() -> case f() =< l() of true -> always; false -> never end. test_f_gg_l() -> case f() > l() of true -> never; false -> always end. test_f_ge_l() -> case f() >= l() of true -> never; false -> always end. +test_f_ll_m() -> case f() < m() of true -> always; false -> never end. +test_f_le_m() -> case f() =< m() of true -> always; false -> never end. +test_f_gg_m() -> case f() > m() of true -> never; false -> always end. +test_f_ge_m() -> case f() >= m() of true -> never; false -> always end. +test_f_ll_b() -> case f() < b() of true -> always; false -> never end. +test_f_le_b() -> case f() =< b() of true -> always; false -> never end. +test_f_gg_b() -> case f() > b() of true -> never; false -> always end. +test_f_ge_b() -> case f() >= b() of true -> never; false -> always end. test_n_ll_i() -> case n() < i() of true -> maybe; false -> maybe_too end. test_n_le_i() -> case n() =< i() of true -> maybe; false -> maybe_too end. @@ -103,6 +127,14 @@ test_n_ll_l() -> case n() < l() of true -> always; false -> never end. test_n_le_l() -> case n() =< l() of true -> always; false -> never end. test_n_gg_l() -> case n() > l() of true -> never; false -> always end. test_n_ge_l() -> case n() >= l() of true -> never; false -> always end. +test_n_ll_m() -> case n() < m() of true -> always; false -> never end. +test_n_le_m() -> case n() =< m() of true -> always; false -> never end. +test_n_gg_m() -> case n() > m() of true -> never; false -> always end. +test_n_ge_m() -> case n() >= m() of true -> never; false -> always end. +test_n_ll_b() -> case n() < b() of true -> always; false -> never end. +test_n_le_b() -> case n() =< b() of true -> always; false -> never end. +test_n_gg_b() -> case n() > b() of true -> never; false -> always end. +test_n_ge_b() -> case n() >= b() of true -> never; false -> always end. test_a_ll_i() -> case a() < i() of true -> never; false -> always end. test_a_le_i() -> case a() =< i() of true -> never; false -> always end. @@ -128,6 +160,14 @@ test_a_ll_l() -> case a() < l() of true -> always; false -> never end. test_a_le_l() -> case a() =< l() of true -> always; false -> never end. test_a_gg_l() -> case a() > l() of true -> never; false -> always end. test_a_ge_l() -> case a() >= l() of true -> never; false -> always end. +test_a_ll_m() -> case a() < m() of true -> always; false -> never end. +test_a_le_m() -> case a() =< m() of true -> always; false -> never end. +test_a_gg_m() -> case a() > m() of true -> never; false -> always end. +test_a_ge_m() -> case a() >= m() of true -> never; false -> always end. +test_a_ll_b() -> case a() < b() of true -> always; false -> never end. +test_a_le_b() -> case a() =< b() of true -> always; false -> never end. +test_a_gg_b() -> case a() > b() of true -> never; false -> always end. +test_a_ge_b() -> case a() >= b() of true -> never; false -> always end. test_t_ll_i() -> case t() < i() of true -> never; false -> always end. test_t_le_i() -> case t() =< i() of true -> never; false -> always end. @@ -153,6 +193,14 @@ test_t_ll_l() -> case t() < l() of true -> always; false -> never end. test_t_le_l() -> case t() =< l() of true -> always; false -> never end. test_t_gg_l() -> case t() > l() of true -> never; false -> always end. test_t_ge_l() -> case t() >= l() of true -> never; false -> always end. +test_t_ll_m() -> case t() < m() of true -> always; false -> never end. +test_t_le_m() -> case t() =< m() of true -> always; false -> never end. +test_t_gg_m() -> case t() > m() of true -> never; false -> always end. +test_t_ge_m() -> case t() >= m() of true -> never; false -> always end. +test_t_ll_b() -> case t() < b() of true -> always; false -> never end. +test_t_le_b() -> case t() =< b() of true -> always; false -> never end. +test_t_gg_b() -> case t() > b() of true -> never; false -> always end. +test_t_ge_b() -> case t() >= b() of true -> never; false -> always end. test_l_ll_i() -> case l() < i() of true -> never; false -> always end. test_l_le_i() -> case l() =< i() of true -> never; false -> always end. @@ -178,6 +226,14 @@ test_l_ll_l() -> case l() < l() of true -> maybe; false -> maybe_too end. test_l_le_l() -> case l() =< l() of true -> maybe; false -> maybe_too end. test_l_gg_l() -> case l() > l() of true -> maybe; false -> maybe_too end. test_l_ge_l() -> case l() >= l() of true -> maybe; false -> maybe_too end. +test_l_ll_m() -> case l() < m() of true -> never; false -> always end. +test_l_le_m() -> case l() =< m() of true -> never; false -> always end. +test_l_gg_m() -> case l() > m() of true -> always; false -> never end. +test_l_ge_m() -> case l() >= m() of true -> always; false -> never end. +test_l_ll_b() -> case l() < b() of true -> always; false -> never end. +test_l_le_b() -> case l() =< b() of true -> always; false -> never end. +test_l_gg_b() -> case l() > b() of true -> never; false -> always end. +test_l_ge_b() -> case l() >= b() of true -> never; false -> always end. test_n_ll_na() -> case n() < na() of true -> maybe; false -> maybe_too end. test_n_le_na() -> case n() =< na() of true -> maybe; false -> maybe_too end. diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps1.erl b/lib/dialyzer/test/small_SUITE_data/src/maps1.erl index 06ced5b69e..bb2f66a498 100644 --- a/lib/dialyzer/test/small_SUITE_data/src/maps1.erl +++ b/lib/dialyzer/test/small_SUITE_data/src/maps1.erl @@ -39,3 +39,15 @@ t2() -> ok. update(#{ id := Id, val := Val } = M, X) when is_integer(Id) -> M#{ val := [Val,X] }. + +t3() -> + foo(#{greger => 3, #{arne=>anka} => 45}, 1). + +foo(#{} = M, b) -> %% Error + M#{alfa => 42, beta := 1337}. + +t4() -> + case #{} of + #{} -> ok; + Mod -> Mod:function(#{literal => map}, another_arg) %% Error + end. diff --git a/lib/diameter/doc/src/diameter.xml b/lib/diameter/doc/src/diameter.xml index 61b7fd1337..5cb29c80e3 100644 --- a/lib/diameter/doc/src/diameter.xml +++ b/lib/diameter/doc/src/diameter.xml @@ -467,7 +467,7 @@ Matches only those peers whose Origin-Host has the specified value, or all peers if the atom <c>any</c>.</p> </item> -<tag><c>{realm, any|&dict_DiameterIdentity;</c></tag> +<tag><c>{realm, any|&dict_DiameterIdentity;}</c></tag> <item> <p> Matches only those peers whose Origin-Realm has the @@ -500,18 +500,22 @@ Matches only those peers matched by each filter in the specified list.</p> <item> <p> Matches only those peers matched by at least one filter in the -specified list.</p> +specified list. +The resulting list will be in match order, peers matching the +first filter of the list sorting before those matched by the second, +and so on.</p> +</item> +<tag><c>{first, [&peer_filter;]}</c></tag> +<item> <p> -The resulting peer list will be in match order, peers matching the -first filter of the list sorting before those matched by the second, -and so on. -For example, the following filter causes peers matching both the host -and realm filters to be presented before those matching only the realm -filter.</p> +Like <c>any</c>, but stops at the first filter for which there are +matches, which can be much more efficient when there are many peers. +For example, the following filter causes only peers best matching +both the host and realm filters to be presented.</p> <pre> -{any, [{all, [host, realm]}, realm]} +{first, [{all, [host, realm]}, realm]} </pre> </item> diff --git a/lib/diameter/src/base/diameter_service.erl b/lib/diameter/src/base/diameter_service.erl index 13508321c3..d49176ec3e 100644 --- a/lib/diameter/src/base/diameter_service.erl +++ b/lib/diameter/src/base/diameter_service.erl @@ -208,7 +208,7 @@ stop_transport(SvcName, [_|_] = Refs) -> info(SvcName, Item) -> case lookup_state(SvcName) of - [#state{} = S] -> + [S] -> service_info(Item, S); [] -> undefined @@ -217,7 +217,12 @@ info(SvcName, Item) -> %% lookup_state/1 lookup_state(SvcName) -> - ets:lookup(?STATE_TABLE, SvcName). + case ets:lookup(?STATE_TABLE, SvcName) of + [#state{}] = L -> + L; + _ -> + [] + end. %% --------------------------------------------------------------------------- %% # subscribe/1 diff --git a/lib/diameter/src/diameter.appup.src b/lib/diameter/src/diameter.appup.src index ddde648e08..ba0e79907c 100644 --- a/lib/diameter/src/diameter.appup.src +++ b/lib/diameter/src/diameter.appup.src @@ -44,6 +44,8 @@ {"1.9.1", [{restart_application, diameter}]}, %% 17.5.3 {"1.9.2", [{restart_application, diameter}]}, %% 17.5.5 {"1.9.2.1", [{restart_application, diameter}]}, %% 17.5.6.3 + {"1.9.2.2", [{restart_application, diameter}]}, %% 17.5.6.7 + {"1.9.2.3", [{restart_application, diameter}]}, %% 17.5.6.8 {"1.10", [{load_module, diameter_codec}, %% 18.0 {load_module, diameter_peer_fsm}, {load_module, diameter_watchdog}, @@ -87,6 +89,8 @@ {"1.9.1", [{restart_application, diameter}]}, {"1.9.2", [{restart_application, diameter}]}, {"1.9.2.1", [{restart_application, diameter}]}, + {"1.9.2.2", [{restart_application, diameter}]}, + {"1.9.2.3", [{restart_application, diameter}]}, {"1.10", [{load_module, diameter_gen_relay}, {load_module, diameter_gen_base_accounting}, {load_module, diameter_gen_base_rfc3588}, diff --git a/lib/diameter/test/diameter_traffic_SUITE.erl b/lib/diameter/test/diameter_traffic_SUITE.erl index 7e316c03f1..967a0bf591 100644 --- a/lib/diameter/test/diameter_traffic_SUITE.erl +++ b/lib/diameter/test/diameter_traffic_SUITE.erl @@ -725,7 +725,8 @@ send_any_2(Config) -> Req = ['STR', {'Termination-Cause', ?LOGOUT}, {'Destination-Host', [?HOST(SN, "unknown.org")]}], ?answer_message(?UNABLE_TO_DELIVER) - = call(Config, Req, [{filter, {any, [host, realm]}}]). + = call(Config, Req, [{filter, {first, [{all, [host, realm]}, + realm]}}]). %% Send with a conjunctive filter. send_all_1(Config) -> diff --git a/lib/edoc/doc/overview.edoc b/lib/edoc/doc/overview.edoc index 3639bb43a5..d2bba9d744 100644 --- a/lib/edoc/doc/overview.edoc +++ b/lib/edoc/doc/overview.edoc @@ -755,7 +755,7 @@ following escape sequences may be used: <dl> === Function specifications === -<note>Although the syntax described in the following can still be used +Note that although the syntax described in the following can still be used for specifying functions we recommend that Erlang specifications as described in <seealso marker="doc/reference_manual:typespec"> Types and Function Specification</seealso> should be added to the source @@ -764,7 +764,6 @@ marker="dialyzer:dialyzer">Dialyzer</seealso>'s can be utilized in the process of keeping the documentation consistent and up-to-date. Erlang specifications will be used unless there is also a function specification (a `@spec' tag followed by a type) with the same name. -</note> The following grammar describes the form of the specifications following a `@spec' tag. A '`?'' suffix implies that the element is optional. @@ -973,12 +972,12 @@ contain any annotations at all. === Type definitions === -<note>Although the syntax described in the following can still be used +Note that although the syntax described in the following can still be used for specifying types we recommend that Erlang types as described in <seealso marker="doc/reference_manual:typespec"> Types and Function Specification</seealso> should be added to the source code instead. Erlang types will be used unless there is a type alias with the same -name.</note> +name. The following grammar (see above for auxiliary definitions) describes the form of the definitions that may follow a `@type' tag: diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl index 90f1fc3071..d2494b69fe 100644 --- a/lib/edoc/src/edoc.erl +++ b/lib/edoc/src/edoc.erl @@ -555,7 +555,6 @@ read_source(Name) -> %% <dd>Specifies a list of pre-defined Erlang preprocessor (`epp') %% macro definitions, used if the `preprocess' option is turned on. %% The default value is the empty list.</dd> -%% </dl> %% <dt>{@type {report_missing_types, boolean()@}} %% </dt> %% <dd>If the value is `true', warnings are issued for missing types. @@ -563,6 +562,7 @@ read_source(Name) -> %% `no_report_missing_types' is an alias for %% `{report_missing_types, false}'. %% </dd> +%% </dl> %% %% @see get_doc/2 %% @see //syntax_tools/erl_syntax diff --git a/lib/edoc/src/edoc_layout.erl b/lib/edoc/src/edoc_layout.erl index b67ec31ae3..f723cd8373 100644 --- a/lib/edoc/src/edoc_layout.erl +++ b/lib/edoc/src/edoc_layout.erl @@ -180,7 +180,9 @@ layout_module(#xmlElement{name = module, content = Es}=E, Opts) -> FullDesc = get_content(fullDescription, Desc), Functions = [{function_name(E), E} || E <- get_content(functions, Es)], Types = [{type_name(E), E} || E <- get_content(typedecls, Es)], - SortedFs = lists:sort(Functions), + SortedFs = if Opts#opts.sort_functions -> lists:sort(Functions); + true -> Functions + end, Body = (navigation("top") ++ [?NL, hr, ?NL, ?NL, {h1, Title}, ?NL] ++ doc_index(FullDesc, Functions, Types) @@ -204,9 +206,7 @@ layout_module(#xmlElement{name = module, content = Es}=E, Opts) -> end ++ types(lists:sort(Types), Opts) ++ function_index(SortedFs, Opts#opts.index_columns) - ++ if Opts#opts.sort_functions -> functions(SortedFs, Opts); - true -> functions(Functions, Opts) - end + ++ functions(SortedFs, Opts) ++ [hr, ?NL] ++ navigation("bottom") ++ timestamp()), diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index bb98e8b04f..f2e5891c2e 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -270,12 +270,8 @@ parms([], []) -> parms([A | As], [D | Ds]) -> [param(A, D) | parms(As, Ds)]. -param(#t_list{type = Type}, Default) -> - param(Type, Default); param(#t_paren{type = Type}, Default) -> param(Type, Default); -param(#t_nonempty_list{type = Type}, Default) -> - param(Type, Default); param(#t_record{name = #t_atom{val = Name}}, _Default) -> list_to_atom(capitalize(atom_to_list(Name))); param(T, Default) -> diff --git a/lib/erl_docgen/src/docgen_otp_specs.erl b/lib/erl_docgen/src/docgen_otp_specs.erl index 37baa7c2f9..e154323f07 100644 --- a/lib/erl_docgen/src/docgen_otp_specs.erl +++ b/lib/erl_docgen/src/docgen_otp_specs.erl @@ -729,5 +729,9 @@ annos_type([E=#xmlElement{name = typevar}]) -> annos_elem(E); annos_type([#xmlElement{name = paren, content = Es}]) -> annos(get_elem(type, Es)); +annos_type([#xmlElement{name = map, content = Es}]) -> + lists:flatmap(fun(E) -> annos_type([E]) end, Es); +annos_type([#xmlElement{name = map_field, content = Es}]) -> + lists:flatmap(fun annos_elem/1, get_elem(type,Es)); annos_type(_) -> []. diff --git a/lib/erl_interface/src/connect/ei_resolve.c b/lib/erl_interface/src/connect/ei_resolve.c index 6381b02393..414cb8be3e 100644 --- a/lib/erl_interface/src/connect/ei_resolve.c +++ b/lib/erl_interface/src/connect/ei_resolve.c @@ -601,16 +601,6 @@ struct hostent *ei_gethostbyaddr(const char *addr, int len, int type) return gethostbyaddr(addr, len, type); } -/* - * Imprecise way to select the actually available gethostbyname_r and - * gethostbyaddr_r. - * - * TODO: check this properly in configure.in - */ -#if (defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) - #define HAVE_GETHOSTBYADDR_R_8 1 -#endif - struct hostent *ei_gethostbyaddr_r(const char *addr, int length, int type, @@ -626,7 +616,7 @@ struct hostent *ei_gethostbyaddr_r(const char *addr, #ifndef HAVE_GETHOSTBYNAME_R return my_gethostbyaddr_r(addr,length,type,hostp,buffer,buflen,h_errnop); #else -#ifdef HAVE_GETHOSTBYADDR_R_8 +#if (defined(__GLIBC__) || defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__)) struct hostent *result; gethostbyaddr_r(addr, length, type, hostp, buffer, buflen, &result, @@ -653,7 +643,7 @@ struct hostent *ei_gethostbyname_r(const char *name, #ifndef HAVE_GETHOSTBYNAME_R return my_gethostbyname_r(name,hostp,buffer,buflen,h_errnop); #else -#ifdef HAVE_GETHOSTBYADDR_R_8 +#if (defined(__GLIBC__) || defined(__linux__) || (__FreeBSD_version >= 602000) || defined(__DragonFly__) || defined(__ANDROID__)) struct hostent *result; gethostbyname_r(name, hostp, buffer, buflen, &result, h_errnop); diff --git a/lib/eunit/src/eunit_data.erl b/lib/eunit/src/eunit_data.erl index 8b53a3681d..cc002cb449 100644 --- a/lib/eunit/src/eunit_data.erl +++ b/lib/eunit/src/eunit_data.erl @@ -761,6 +761,7 @@ lazy_test_() -> lazy_gen(7), ?_assertMatch(7, get(count))]}. +-dialyzer({no_improper_lists, lazy_gen/1}). lazy_gen(N) -> {generator, fun () -> diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl index d8f98cffa5..4dbe023257 100644 --- a/lib/eunit/src/eunit_lib.erl +++ b/lib/eunit/src/eunit_lib.erl @@ -192,6 +192,7 @@ error_msg(Title, Fmt, Args) -> io_lib:fwrite("*** ~ts ***\n~ts\n\n", [Title, Msg]). -ifdef(TEST). +-dialyzer({no_match, format_exception_test_/0}). format_exception_test_() -> [?_assertMatch( "\nymmud:rorre"++_, @@ -273,6 +274,7 @@ dlist_next([], Xs) -> -ifdef(TEST). +-dialyzer({no_match, dlist_test_/0}). dlist_test_() -> {"deep list traversal", [{"non-list term -> singleton list", @@ -338,6 +340,7 @@ is_nonempty_string([]) -> false; is_nonempty_string(Cs) -> is_string(Cs). -ifdef(TEST). +-dialyzer({no_match, is_string_test_/0}). is_string_test_() -> {"is_string", [{"no non-lists", ?_assert(not is_string($A))}, @@ -399,6 +402,7 @@ uniq([X | Xs]) -> [X | uniq(Xs)]; uniq([]) -> []. -ifdef(TEST). +-dialyzer({[no_match, no_fail_call, no_improper_lists], uniq_test_/0}). uniq_test_() -> {"uniq", [?_assertError(function_clause, uniq(ok)), @@ -459,6 +463,7 @@ normalize([]) -> -ifdef(TEST). +-dialyzer({no_match, cmd_test_/0}). cmd_test_() -> ([?_test({0, "hello\n"} = ?_cmd_("echo hello"))] ++ case os:type() of @@ -576,6 +581,7 @@ trie_match([], _T) -> -ifdef(TEST). +-dialyzer({no_match, trie_test_/0}). trie_test_() -> [{"basic representation", [?_assert(trie_new() =:= gb_trees:empty()), diff --git a/lib/eunit/src/eunit_listener.erl b/lib/eunit/src/eunit_listener.erl index ecaac424a2..d9b836863b 100644 --- a/lib/eunit/src/eunit_listener.erl +++ b/lib/eunit/src/eunit_listener.erl @@ -27,14 +27,11 @@ -export([start/1, start/2]). --export([behaviour_info/1]). - - -behaviour_info(callbacks) -> - [{init,1},{handle_begin,3},{handle_end,3},{handle_cancel,3}, - {terminate,2}]; -behaviour_info(_Other) -> - undefined. +-callback init(_) -> _. +-callback handle_begin(_, _, _) -> _. +-callback handle_end(_, _, _) -> _. +-callback handle_cancel(_, _, _) -> _. +-callback terminate(_, _) -> _. -record(state, {callback, % callback module @@ -50,18 +47,22 @@ start(Callback) -> start(Callback, Options) -> St = #state{callback = Callback}, - spawn_opt(fun () -> init(St, Options) end, + spawn_opt(init_fun(St, Options), proplists:get_all_values(spawn, Options)). -init(St0, Options) -> - St1 = call(init, [Options], St0), - St2 = expect([], undefined, St1), - Data = [{pass, St2#state.pass}, - {fail, St2#state.fail}, - {skip, St2#state.skip}, - {cancel, St2#state.cancel}], - call(terminate, [{ok, Data}, St2#state.state], St2), - exit(normal). +-spec init_fun(_, _) -> no_return(). + +init_fun(St0, Options) -> + fun () -> + St1 = call(init, [Options], St0), + St2 = expect([], undefined, St1), + Data = [{pass, St2#state.pass}, + {fail, St2#state.fail}, + {skip, St2#state.skip}, + {cancel, St2#state.cancel}], + call(terminate, [{ok, Data}, St2#state.state], St2), + exit(normal) + end. expect(Id, ParentId, St) -> case wait_for(Id, 'begin', ParentId) of diff --git a/lib/eunit/src/eunit_proc.erl b/lib/eunit/src/eunit_proc.erl index 98ae31d54b..8bdf94c877 100644 --- a/lib/eunit/src/eunit_proc.erl +++ b/lib/eunit/src/eunit_proc.erl @@ -268,6 +268,8 @@ insulator_wait(Child, Parent, Buf, St) -> kill_task(Child, St) end. +-spec kill_task(_, _) -> no_return(). + kill_task(Child, St) -> exit(Child, kill), terminate_insulator(St). diff --git a/lib/eunit/src/eunit_serial.erl b/lib/eunit/src/eunit_serial.erl index 1a0179a5df..da76064a53 100644 --- a/lib/eunit/src/eunit_serial.erl +++ b/lib/eunit/src/eunit_serial.erl @@ -61,14 +61,16 @@ messages = dict:new() :: dict:dict()}). start(Pids) -> - spawn(fun () -> serializer(Pids) end). - -serializer(Pids) -> - St = #state{listeners = sets:from_list(Pids), - cancelled = eunit_lib:trie_new(), - messages = dict:new()}, - expect([], undefined, 0, St), - exit(normal). + spawn(serializer_fun(Pids)). + +serializer_fun(Pids) -> + fun () -> + St = #state{listeners = sets:from_list(Pids), + cancelled = eunit_lib:trie_new(), + messages = dict:new()}, + expect([], undefined, 0, St), + exit(normal) + end. %% collect beginning and end of an expected item; return {Done, NewSt} %% where Done is true if there are no more items of this group diff --git a/lib/eunit/src/eunit_test.erl b/lib/eunit/src/eunit_test.erl index 9cf40a738d..62d30b1930 100644 --- a/lib/eunit/src/eunit_test.erl +++ b/lib/eunit/src/eunit_test.erl @@ -40,6 +40,7 @@ get_stacktrace() -> get_stacktrace(Ts) -> eunit_lib:uniq(prune_trace(erlang:get_stacktrace(), Ts)). +-dialyzer({no_match, prune_trace/2}). prune_trace([{eunit_data, _, _} | Rest], Tail) -> prune_trace(Rest, Tail); prune_trace([{eunit_data, _, _, _} | Rest], Tail) -> @@ -75,6 +76,7 @@ run_testfun(F) -> -ifdef(TEST). +-dialyzer({[no_match, no_fail_call, no_return], macro_test_/0}). macro_test_() -> {"macro definitions", [{?LINE, fun () -> @@ -301,6 +303,7 @@ wrapper_test_() -> ]}. %% this must be exported (done automatically by the autoexport transform) +-dialyzer({no_missing_calls, wrapper_test_exported_/0}). wrapper_test_exported_() -> {ok, ?MODULE:nonexisting_function()}. -endif. diff --git a/lib/eunit/src/eunit_tests.erl b/lib/eunit/src/eunit_tests.erl index 47ea0aaf46..5dee1cb49e 100644 --- a/lib/eunit/src/eunit_tests.erl +++ b/lib/eunit/src/eunit_tests.erl @@ -23,6 +23,8 @@ -include("eunit.hrl"). +-dialyzer(no_match). + -ifdef(TEST). id(X) -> X. % for suppressing compiler warnings -endif. diff --git a/lib/hipe/cerl/cerl_prettypr.erl b/lib/hipe/cerl/cerl_prettypr.erl index 7e8b7f60bd..1a6e6999fe 100644 --- a/lib/hipe/cerl/cerl_prettypr.erl +++ b/lib/hipe/cerl/cerl_prettypr.erl @@ -64,8 +64,8 @@ seq_arg/1, seq_body/1, string_lit/1, try_arg/1, try_body/1, try_vars/1, try_evars/1, try_handler/1, tuple_es/1, type/1, values_es/1, var_name/1, - c_map/1, map_arg/1, map_es/1, is_c_map_empty/1, - c_map_pair/2, map_pair_key/1, map_pair_val/1, map_pair_op/1 + map_arg/1, map_es/1, is_c_map_empty/1, + map_pair_key/1, map_pair_val/1, map_pair_op/1 ]). -define(PAPER, 76). @@ -499,12 +499,8 @@ lay_literal(Node, Ctxt) -> lay_cons(Node, Ctxt); V when is_tuple(V) -> lay_tuple(Node, Ctxt); - M when is_map(M), map_size(M) =:= 0 -> - text("~{}~"); M when is_map(M) -> - lay_map(c_map([c_map_pair(abstract(K),abstract(V)) - || {K,V} <- maps:to_list(M)]), - Ctxt) + lay_map(Node, Ctxt) end. lay_var(Node, Ctxt) -> @@ -627,12 +623,10 @@ lay_map_pair(Node, Ctxt) -> K = map_pair_key(Node), V = map_pair_val(Node), OpTxt = case concrete(map_pair_op(Node)) of - assoc -> "::<"; - exact -> "~<" + assoc -> "=>"; + exact -> ":=" end, - beside(floating(text(OpTxt)), - beside(lay(K,Ctxt),beside(floating(text(",")), beside(lay(V,Ctxt), - floating(text(">")))))). + beside(lay(K,Ctxt),beside(floating(text(OpTxt)),lay(V,Ctxt))). lay_let(Node, Ctxt) -> V = lay_value_list(let_vars(Node), Ctxt), diff --git a/lib/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl index 97b95f2e7c..ab131c2d01 100644 --- a/lib/hipe/cerl/cerl_to_icode.erl +++ b/lib/hipe/cerl/cerl_to_icode.erl @@ -794,9 +794,9 @@ bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo, Type, Flags, Base, Offset) -> SL = new_label(), case SizeInfo of - {all,_NewUnit, NewAlign, S1} -> + {all, NewUnit, NewAlign, S1} -> Type = binary, - Name = {bs_put_binary_all, Flags}, + Name = {bs_put_binary_all, NewUnit, Flags}, Primop = {hipe_bs_primop, Name}, {add_code([icode_guardop([Offset], Primop, [V, Base, Offset], SL, FL), @@ -819,9 +819,9 @@ bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo, bitstr_gen_op([V], _Ctxt, SizeInfo, ConstInfo, Type, Flags, Base, Offset) -> case SizeInfo of - {all, _NewUnit, NewAlign, S} -> + {all, NewUnit, NewAlign, S} -> Type = binary, - Name = {bs_put_binary_all, Flags}, + Name = {bs_put_binary_all, NewUnit, Flags}, Primop = {hipe_bs_primop, Name}, {add_code([icode_call_primop([Offset], Primop, [V, Base, Offset])], S), diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index c2fb79c089..9f23b6a9b3 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2015. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -2200,7 +2200,7 @@ type_ranks(Type, I, Min, Max, [TypeClass|Rest], Opaques) -> type_order() -> [t_number(), t_atom(), t_reference(), t_fun(), t_port(), t_pid(), t_tuple(), - t_list(), t_binary()]. + t_map(), t_list(), t_bitstr()]. key_comparisons_fail(X0, KeyPos, TupleList, Opaques) -> X = case t_is_number(t_inf(X0, t_number(), Opaques), Opaques) of @@ -2300,7 +2300,7 @@ arg_types(erlang, bit_size, 1) -> [t_bitstr()]; %% Guard bif, needs to be here. arg_types(erlang, byte_size, 1) -> - [t_binary()]; + [t_bitstr()]; arg_types(erlang, disconnect_node, 1) -> [t_node()]; arg_types(erlang, halt, 0) -> diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index cd2d2fe207..7a2abc226f 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2711,7 +2711,6 @@ is_compat_args([A1|Args1], [A2|Args2]) -> is_compat_args([], []) -> true; is_compat_args(_, _) -> false. -is_compat_arg(A, A) -> true; is_compat_arg(A1, A2) -> is_specialization(A1, A2) orelse is_specialization(A2, A1). @@ -2722,6 +2721,7 @@ is_compat_arg(A1, A2) -> %% any(). For example, {_,_} is a specialization of any(), but not of %% tuple(). Does not handle variables, but any() and unions (sort of). +is_specialization(T, T) -> true; is_specialization(_, ?any) -> true; is_specialization(?any, _) -> false; is_specialization(?function(Domain1, Range1), ?function(Domain2, Range2)) -> @@ -2747,8 +2747,8 @@ is_specialization(?tuple(Elements1, Arity, _), specialization_list(Elements1, sup_tuple_elements(List)); is_specialization(?tuple_set(List1), ?tuple_set(List2)) -> try - specialization_list(lists:append([T || {_Arity, T} <- List1]), - lists:append([T || {_Arity, T} <- List2])) + specialization_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1], + [sup_tuple_elements(T) || {_Arity, T} <- List2]) catch _:_ -> false end; is_specialization(?union(List1)=T1, ?union(List2)=T2) -> @@ -2772,13 +2772,19 @@ is_specialization(T1, ?opaque(_) = T2) -> is_specialization(T1, t_opaque_structure(T2)); is_specialization(?var(_), _) -> exit(error); is_specialization(_, ?var(_)) -> exit(error); -is_specialization(T, T) -> true; is_specialization(?none, _) -> false; is_specialization(_, ?none) -> false; is_specialization(?unit, _) -> false; is_specialization(_, ?unit) -> false; is_specialization(#c{}, #c{}) -> false. +specialization_list_list(LL1, LL2) -> + length(LL1) =:= length(LL2) andalso specialization_list_list1(LL1, LL2). + +specialization_list_list1([], []) -> true; +specialization_list_list1([L1|LL1], [L2|LL2]) -> + specialization_list(L1, L2) andalso specialization_list_list1(LL1, LL2). + specialization_list(L1, L2) -> length(L1) =:= length(L2) andalso specialization_list1(L1, L2). diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 0c7bdb788a..37c6ba9c60 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -881,6 +881,15 @@ trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}| trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> Dst = mk_var(Res), Temp = mk_var(new), + {FailLblName, FailCode} = + if Lbl =:= 0 -> + FailLbl = mk_label(new), + {hipe_icode:label_name(FailLbl), + [FailLbl, + hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error)]}; + true -> + {map_label(Lbl), []} + end, MultIs = case {New,Unit} of {{integer, NewInt}, _} -> @@ -890,40 +899,26 @@ trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> [hipe_icode:mk_move(Temp, NewVar)]; _ -> NewVar = mk_var(New), - if Lbl =:= 0 -> - [hipe_icode:mk_primop([Temp], '*', - [NewVar, hipe_icode:mk_const(Unit)])]; - true -> - Succ = mk_label(new), - [hipe_icode:mk_primop([Temp], '*', - [NewVar, hipe_icode:mk_const(Unit)], - hipe_icode:label_name(Succ), map_label(Lbl)), - Succ] - end + Succ = mk_label(new), + [hipe_icode:mk_primop([Temp], '*', + [NewVar, hipe_icode:mk_const(Unit)], + hipe_icode:label_name(Succ), FailLblName), + Succ] end, Succ2 = mk_label(new), - {FailLblName, FailCode} = - if Lbl =:= 0 -> - FailLbl = mk_label(new), - {hipe_icode:label_name(FailLbl), - [FailLbl, - hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error)]}; - true -> - {map_label(Lbl), []} - end, IsPos = [hipe_icode:mk_if('>=', [Temp, hipe_icode:mk_const(0)], hipe_icode:label_name(Succ2), FailLblName)] ++ - FailCode ++ [Succ2], - AddI = + FailCode ++ [Succ2], + AddRhs = case Old of - {integer,OldInt} -> - hipe_icode:mk_primop([Dst], '+', [Temp, hipe_icode:mk_const(OldInt)]); - _ -> - OldVar = mk_var(Old), - hipe_icode:mk_primop([Dst], '+', [Temp, OldVar]) + {integer,OldInt} -> hipe_icode:mk_const(OldInt); + _ -> mk_var(Old) end, - MultIs ++ IsPos ++ [AddI|trans_fun(Instructions, Env)]; + Succ3 = mk_label(new), + AddI = hipe_icode:mk_primop([Dst], '+', [Temp, AddRhs], + hipe_icode:label_name(Succ3), FailLblName), + MultIs ++ IsPos ++ [AddI,Succ3|trans_fun(Instructions, Env)]; %%-------------------------------------------------------------------- %% Bit syntax instructions added in R12B-5 (Fall 2008) %%-------------------------------------------------------------------- @@ -1306,7 +1301,7 @@ trans_bin([{bs_put_binary,{f,Lbl},Size,Unit,{field_flags,Flags},Source}| {Name, Args, Env2} = case Size of {atom,all} -> %% put all bits - {{bs_put_binary_all, Flags}, [Src,Base,Offset], Env}; + {{bs_put_binary_all, Unit, Flags}, [Src,Base,Offset], Env}; {integer,NoBits} when is_integer(NoBits), NoBits >= 0 -> %% Create a N*Unit bits subbinary {{bs_put_binary, NoBits*Unit, Flags}, [Src,Base,Offset], Env}; diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl index ffb51b2ea4..84aae30291 100644 --- a/lib/hipe/icode/hipe_icode_primops.erl +++ b/lib/hipe/icode/hipe_icode_primops.erl @@ -116,7 +116,7 @@ is_safe({hipe_bs_primop, {bs_init, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_init_bits, _}}) -> false; is_safe({hipe_bs_primop, {bs_init_bits, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_binary, _, _}}) -> false; -is_safe({hipe_bs_primop, {bs_put_binary_all, _}}) -> false; +is_safe({hipe_bs_primop, {bs_put_binary_all, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_float, _, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_string, _, _}}) -> false; @@ -219,7 +219,7 @@ fails({hipe_bs_primop, {bs_init, _, _}}) -> true; fails({hipe_bs_primop, {bs_init_bits, _}}) -> true; fails({hipe_bs_primop, {bs_init_bits, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_binary, _, _}}) -> true; -fails({hipe_bs_primop, {bs_put_binary_all, _}}) -> true; +fails({hipe_bs_primop, {bs_put_binary_all, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_float, _, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_string, _, _}}) -> true; @@ -265,8 +265,8 @@ pp(Dev, Op) -> io:format(Dev, "gc_test<~w>", [N]); {hipe_bs_primop, BsOp} -> case BsOp of - {bs_put_binary_all, Flags} -> - io:format(Dev, "bs_put_binary_all<~w>", [Flags]); + {bs_put_binary_all, Unit, Flags} -> + io:format(Dev, "bs_put_binary_all<~w, ~w>", [Unit,Flags]); {bs_put_binary, Size} -> io:format(Dev, "bs_put_binary<~w>", [Size]); {bs_put_binary, Flags, Size} -> @@ -505,11 +505,13 @@ type(Primop, Args) -> NewMatchState = erl_types:t_matchstate_update_present(NewBinType, MatchState), if Signed =:= 0 -> - erl_types:t_product([erl_types:t_from_range(0, 1 bsl Size - 1), + UpperBound = inf_add(safe_bsl(1, Size), -1), + erl_types:t_product([erl_types:t_from_range(0, UpperBound), NewMatchState]); Signed =:= 4 -> - erl_types:t_product([erl_types:t_from_range(- (1 bsl (Size-1)), - (1 bsl (Size-1)) - 1), + erl_types:t_product([erl_types:t_from_range( + inf_inv(safe_bsl(1, Size-1)), + inf_add(safe_bsl(1, Size-1), -1)), NewMatchState]) end; [_Arg] -> @@ -628,8 +630,9 @@ type(Primop, Args) -> [_SrcType, _BitsType, _Base, Type] -> erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(Size, 0)) end; - {hipe_bs_primop, {bs_put_binary_all, _Flags}} -> - [SrcType, _Base, Type] = Args, + {hipe_bs_primop, {bs_put_binary_all, Unit, _Flags}} -> + [SrcType0, _Base, Type] = Args, + SrcType = erl_types:t_inf(erl_types:t_bitstr(Unit, 0), SrcType0), erl_types:t_bitstr_concat(SrcType,Type); {hipe_bs_primop, {bs_put_string, _, Size}} -> [_Base, Type] = Args, @@ -965,3 +968,19 @@ check_fun_args(_, _) -> match_bin(Pattern, Match) -> erl_types:t_bitstr_match(Pattern, Match). + +safe_bsl(0, _) -> 0; +safe_bsl(Base, Shift) when Shift =< 128 -> Base bsl Shift; +safe_bsl(Base, _Shift) when Base > 0 -> pos_inf; +safe_bsl(Base, _Shift) when Base < 0 -> neg_inf. + +inf_inv(pos_inf) -> neg_inf; +inf_inv(neg_inf) -> pos_inf; +inf_inv(Number) -> -Number. + +inf_add(pos_inf, _Number) -> pos_inf; +inf_add(neg_inf, _Number) -> neg_inf; +inf_add(_Number, pos_inf) -> pos_inf; +inf_add(_Number, neg_inf) -> neg_inf; +inf_add(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> + Number1 + Number2. diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl index ba5fa1bfd7..9a20527a83 100644 --- a/lib/hipe/icode/hipe_icode_range.erl +++ b/lib/hipe/icode/hipe_icode_range.erl @@ -1202,11 +1202,11 @@ basic_type(#unsafe_update_element{}) -> not_analysed. analyse_bs_get_integer(Size, Flags, true) -> Signed = Flags band 4, if Signed =:= 0 -> - Max = 1 bsl Size - 1, + Max = inf_add(inf_bsl(1, Size), -1), Min = 0; true -> - Max = 1 bsl (Size-1) - 1, - Min = -(1 bsl (Size-1)) + Max = inf_add(inf_bsl(1, Size-1), -1), + Min = inf_inv(inf_bsl(1, Size-1)) end, {Min, Max}; analyse_bs_get_integer(Size, Flags, false) when is_integer(Size), diff --git a/lib/hipe/rtl/hipe_rtl_arith.inc b/lib/hipe/rtl/hipe_rtl_arith.inc index 1f455f47ed..1dff56b074 100644 --- a/lib/hipe/rtl/hipe_rtl_arith.inc +++ b/lib/hipe/rtl/hipe_rtl_arith.inc @@ -30,13 +30,13 @@ %% Returns a tuple %% {Res, Sign, Zero, Overflow, Carry} %% Res will be a number in the range -%% MAX_SIGNED_INT >= Res >= MIN_SIGNED_INT +%% MAX_UNSIGNED_INT >= Res >= 0 %% The other four values are flags that are either true or false %% eval_alu(Op, Arg1, Arg2) - when Arg1 =< ?MAX_SIGNED_INT, + when Arg1 =< ?MAX_UNSIGNED_INT, Arg1 >= ?MIN_SIGNED_INT, - Arg2 =< ?MAX_SIGNED_INT, + Arg2 =< ?MAX_UNSIGNED_INT, Arg2 >= ?MIN_SIGNED_INT -> Sign1 = sign_bit(Arg1), @@ -111,7 +111,7 @@ eval_alu(Op, Arg1, Arg2) Res = N = Z = V = C = 0, ?EXIT({"unknown alu op", Op}) end, - {two_comp_to_erl(Res), N, Z, V, C}; + {Res, N, Z, V, C}; eval_alu(Op, Arg1, Arg2) -> ?EXIT({argument_overflow,Op,Arg1,Arg2}). @@ -162,16 +162,9 @@ eval_cond(Cond, Arg1, Arg2) -> sign_bit(Val) -> ((Val bsr ?SIGN_BIT) band 1) =:= 1. -two_comp_to_erl(V) -> - if V > ?MAX_SIGNED_INT -> - - ((?MAX_UNSIGNED_INT + 1) - V); - true -> V - end. - shiftmask(Arg) -> Setbits = ?BITS - Arg, (1 bsl Setbits) - 1. zero(Val) -> Val =:= 0. - diff --git a/lib/hipe/rtl/hipe_rtl_arith_32.erl b/lib/hipe/rtl/hipe_rtl_arith_32.erl index 572556be1c..d790a8b981 100644 --- a/lib/hipe/rtl/hipe_rtl_arith_32.erl +++ b/lib/hipe/rtl/hipe_rtl_arith_32.erl @@ -24,7 +24,8 @@ %% Filename : hipe_rtl_arith_32.erl %% Module : hipe_rtl_arith_32 %% Purpose : To implement 32-bit RTL-arithmetic -%% Notes : The arithmetic works on 32-bit signed integers. +%% Notes : The arithmetic works on 32-bit signed and unsigned +%% integers. %% The implementation is taken from the implementation %% of arithmetic on SPARC. %% XXX: This code is seldom used, and hence also diff --git a/lib/hipe/rtl/hipe_rtl_binary.erl b/lib/hipe/rtl/hipe_rtl_binary.erl index b549073050..9cbab08ee2 100644 --- a/lib/hipe/rtl/hipe_rtl_binary.erl +++ b/lib/hipe/rtl/hipe_rtl_binary.erl @@ -1,3 +1,4 @@ +%% -*- erlang-indent-level: 2 -*- %%% %%% %CopyrightBegin% %%% @@ -28,11 +29,20 @@ -export([gen_rtl/7]). +-export([floorlog2/1, get_word_integer/4, make_size/3, make_size/4]). + +%%-------------------------------------------------------------------- + +-define(BYTE_SHIFT, 3). %% Turn bits into bytes or vice versa +-define(BYTE_SIZE, 8). + +%%-------------------------------------------------------------------- + gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab) -> case type_of_operation(BsOP) of match -> {hipe_rtl_binary_match:gen_rtl( - BsOP, Dst, Args, TrueLblName, FalseLblName),ConstTab}; + BsOP, Dst, Args, TrueLblName, FalseLblName),ConstTab}; construct -> hipe_rtl_binary_construct:gen_rtl( BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab) @@ -62,7 +72,7 @@ type_of_operation({bs_init,_,_}) -> construct; type_of_operation({bs_init_bits,_}) -> construct; type_of_operation({bs_init_bits,_,_}) -> construct; type_of_operation({bs_put_binary,_,_}) -> construct; -type_of_operation({bs_put_binary_all,_}) -> construct; +type_of_operation({bs_put_binary_all,_,_}) -> construct; type_of_operation({bs_put_float,_,_,_}) -> construct; type_of_operation({bs_put_integer,_,_,_}) -> construct; type_of_operation({bs_put_string,_,_}) -> construct; @@ -79,3 +89,133 @@ type_of_operation(bs_final) -> construct; type_of_operation({bs_append,_,_,_,_}) -> construct; type_of_operation({bs_private_append,_,_}) -> construct; type_of_operation(bs_init_writable) -> construct. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Small utility functions: +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +create_lbls(X) when X > 0 -> + [hipe_rtl:mk_new_label()|create_lbls(X-1)]; +create_lbls(0) -> + []. + +%%------------------------------------------------------------------------------ +%% Utilities used by both hipe_rtl_binary_construct and hipe_rtl_binary_match +%%------------------------------------------------------------------------------ + +get_word_integer(Var, Register, SystemLimitLblName, FalseLblName) -> + [EndLbl] = create_lbls(1), + EndName = hipe_rtl:label_name(EndLbl), + get_word_integer(Var, Register,SystemLimitLblName, FalseLblName, EndName, EndName, + [EndLbl]). + +get_word_integer(Var, Register, SystemLimitLblName, FalseLblName, TrueLblName, + BigLblName, Tail) -> + [FixnumLbl, NotFixnumLbl, BignumLbl, SuccessLbl] = create_lbls(4), + [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(FixnumLbl), + hipe_rtl:label_name(NotFixnumLbl), 0.99), + FixnumLbl, + hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), + hipe_rtl:label_name(SuccessLbl), FalseLblName, + 0.99), + SuccessLbl, + hipe_tagscheme:untag_fixnum(Register, Var), + hipe_rtl:mk_goto(TrueLblName), + NotFixnumLbl, + hipe_tagscheme:test_pos_bignum_arity(Var, 1, hipe_rtl:label_name(BignumLbl), + FalseLblName, SystemLimitLblName, 0.99), + BignumLbl, + hipe_tagscheme:unsafe_get_one_word_pos_bignum(Register, Var), + hipe_rtl:mk_goto(BigLblName) | Tail]. + +make_size(UnitImm, BitsVar, FailLblName) -> + make_size(UnitImm, BitsVar, FailLblName, FailLblName). + +make_size(1, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + {get_word_integer(BitsVar, DstReg, OverflowLblName, FalseLblName), DstReg}; +make_size(?BYTE_SIZE, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + [FixnumLbl, BignumLbl] = create_lbls(2), + WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, + FixnumLblName = hipe_rtl:label_name(FixnumLbl), + Tail = [BignumLbl, + hipe_rtl:mk_branch(DstReg, 'ltu', + hipe_rtl:mk_imm(1 bsl (WordBits - ?BYTE_SHIFT)), + FixnumLblName, OverflowLblName, 0.99), + FixnumLbl, + hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))], + Code = get_word_integer(BitsVar, DstReg, OverflowLblName, FalseLblName, + FixnumLblName, hipe_rtl:label_name(BignumLbl), Tail), + {Code, DstReg}; +make_size(UnitImm, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + UnitList = number2list(UnitImm), + Code = multiply_code(UnitList, BitsVar, DstReg, OverflowLblName, FalseLblName), + {Code, DstReg}. + +multiply_code(List=[Head|_Tail], Variable, Result, OverflowLblName, + FalseLblName) -> + Test = set_high(Head), + Tmp1 = hipe_rtl:mk_new_reg(), + SuccessLbl = hipe_rtl:mk_new_label(), + Register = hipe_rtl:mk_new_reg(), + Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| + get_word_integer(Variable, Register, OverflowLblName, FalseLblName)] + ++ + [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), + eq, hipe_rtl:label_name(SuccessLbl), + OverflowLblName, 0.99), + SuccessLbl], + multiply_code(List, Register, Result, OverflowLblName, Tmp1, Code). + +multiply_code([ShiftSize|Rest], Register, Result, OverflowLblName, Tmp1, + OldCode) -> + SuccessLbl = hipe_rtl:mk_new_label(), + Code = + OldCode ++ + [hipe_rtl:mk_alu(Tmp1, Register, sll, hipe_rtl:mk_imm(ShiftSize)), + hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, + hipe_rtl:label_name(SuccessLbl), OverflowLblName, 0.99), + SuccessLbl], + multiply_code(Rest, Register, Result, OverflowLblName, Tmp1, Code); +multiply_code([], _Register, _Result, _OverflowLblName, _Tmp1, Code) -> + Code. + +set_high(X) -> + WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, + set_high(min(X, WordBits), WordBits, 0). + +set_high(0, _, Y) -> + Y; +set_high(X, WordBits, Y) -> + set_high(X-1, WordBits, Y+(1 bsl (WordBits-X))). + + +number2list(X) when is_integer(X), X >= 0 -> + number2list(X, []). + +number2list(1, Acc) -> + lists:reverse([0|Acc]); +number2list(0, Acc) -> + lists:reverse(Acc); +number2list(X, Acc) -> + F = floorlog2(X), + number2list(X-(1 bsl F), [F|Acc]). + +floorlog2(X) -> + %% Double-precision floats do not have enough precision to make floorlog2 + %% exact for integers larger than 2^47. + Approx = round(math:log(X)/math:log(2)-0.5), + floorlog2_refine(X, Approx). + +floorlog2_refine(X, Approx) -> + if (1 bsl Approx) > X -> + floorlog2_refine(X, Approx - 1); + (1 bsl (Approx+1)) > X -> + Approx; + true -> + floorlog2_refine(X, Approx + 1) + end. diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index 692bad7d96..4403aa552f 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -34,6 +34,10 @@ get_field_from_term/3, set_field_from_pointer/3, get_field_from_pointer/3]). + +-import(hipe_rtl_binary, [floorlog2/1, + get_word_integer/4, + make_size/4]). %%------------------------------------------------------------------------- -include("../main/hipe.hrl"). @@ -94,10 +98,11 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab var_init_bits(Size, Dst0, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName); - {bs_put_binary_all, _Flags} -> + {bs_put_binary_all, Unit, _Flags} -> [Src, Base, Offset] = Args, [NewOffset] = get_real(Dst), - put_binary_all(NewOffset, Src, Base, Offset, TrueLblName, FalseLblName); + put_binary_all(NewOffset, Src, Base, Offset, Unit, + TrueLblName, FalseLblName); {bs_put_binary, Size, _Flags} -> case is_illegal_const(Size) of @@ -110,7 +115,9 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab put_static_binary(NewOffset, Src, Size, Base, Offset, TrueLblName, FalseLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, FalseLblName), + {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, + FalseLblName), InCode = put_dynamic_binary(NewOffset, Src, SizeReg, Base, Offset, TrueLblName, FalseLblName), SizeCode ++ InCode @@ -132,7 +139,9 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab put_float(NewOffset, Src, Base, Offset, Size, CCode, Aligned, LittleEndian, ConstInfo, TrueLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, FalseLblName), + {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, + FalseLblName), InCode = float_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, TrueLblName, FalseLblName), SizeCode ++ InCode @@ -161,6 +170,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab CCode, Aligned, LittleEndian, TrueLblName); [Src, Bits, Base, Offset] -> {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, FalseLblName), CCode = int_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, @@ -209,6 +219,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab TrueLblName); [Src, Bits, Base, Offset] -> {SizeCode, SizeReg} = make_size(Size, Bits, + SystemLimitLblName, FalseLblName), CCode = int_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, @@ -293,7 +304,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab [SizeReg] = create_regs(1), [Base] = create_unsafe_regs(1), [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE + ?SUB_BIN_WORDSIZE), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), allocate_writable(DstVar, Base, SizeReg, Zero, Zero), hipe_rtl:mk_goto(TrueLblName)]; @@ -305,7 +316,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab SubBinSize = {sub_binary, binsize}, [get_field_from_term({sub_binary, orig}, Bin, ProcBin), get_field_from_term(SubBinSize, Bin, SubSize), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), realloc_binary(SizeReg, ProcBin, Base), calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), set_field_from_term(SubBinSize, Bin, EndSubSize), @@ -313,20 +324,21 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab hipe_rtl:mk_move(DstVar, Bin), hipe_rtl:mk_goto(TrueLblName)]; - {bs_append, _U, _F, _B, _Bla} -> + {bs_append, _U, _F, Unit, _Bla} -> [Size, Bin] = Args, [DstVar, Base, Offset] = Dst, [ProcBin] = create_vars(1), [Flags, SizeReg, IsWritable, EndSubSize, EndSubBitSize] = create_regs(5), - [ContLbl,ContLbl2,ContLbl3,WritableLbl,NotWritableLbl] = Lbls = - create_lbls(5), - [ContLblName, ContLbl2Name, ContLbl3Name, Writable, NotWritable] = + [ContLbl,ContLbl2,ContLbl3,ContLbl4,WritableLbl,NotWritableLbl] = + Lbls = create_lbls(6), + [ContLblName, ContLbl2Name, ContLbl3Name, ContLbl4Name, + Writable, NotWritable] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls], Zero = hipe_rtl:mk_imm(0), SubIsWritable = {sub_binary, is_writable}, [hipe_rtl:mk_gctest(?SUB_BIN_WORDSIZE + ?PROC_BIN_WORDSIZE), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), hipe_tagscheme:test_bitstr(Bin, ContLblName, FalseLblName, 0.99), ContLbl, hipe_tagscheme:test_subbinary(Bin,ContLbl2Name, NotWritable), @@ -339,17 +351,19 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab get_field_from_term({proc_bin, flags}, ProcBin, Flags), hipe_rtl:mk_alub(Flags, Flags, 'and', hipe_rtl:mk_imm(?PB_IS_WRITABLE), - eq, NotWritable, Writable, 0.01), + eq, NotWritable, ContLbl4Name, 0.01), + ContLbl4, + calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), + is_divisible(Offset, Unit, Writable, FalseLblName), WritableLbl, set_field_from_term(SubIsWritable, Bin, Zero), realloc_binary(SizeReg, ProcBin, Base), - calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), hipe_tagscheme:mk_sub_binary(DstVar, EndSubSize, Zero, EndSubBitSize, Zero, hipe_rtl:mk_imm(1), ProcBin), hipe_rtl:mk_goto(TrueLblName), NotWritableLbl, - not_writable_code(Bin, SizeReg, DstVar, Base, Offset, + not_writable_code(Bin, SizeReg, DstVar, Base, Offset, Unit, TrueLblName, FalseLblName)] end, {Code, ConstTab} @@ -361,7 +375,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -not_writable_code(Bin, SizeReg, Dst, Base, Offset, +not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit, TrueLblName, FalseLblName) -> [SrcBase] = create_unsafe_regs(1), [SrcOffset, SrcSize, TotSize, TotBytes, UsedBytes] = create_regs(5), @@ -372,13 +386,13 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, hipe_rtl:mk_alu(TotBytes, TotSize, add, ?LOW_BITS), hipe_rtl:mk_alu(TotBytes, TotBytes, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(UsedBytes, TotBytes, sll, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_branch(UsedBytes, ge, hipe_rtl:mk_imm(256), + hipe_rtl:mk_branch(UsedBytes, geu, hipe_rtl:mk_imm(256), AllLblName, IncLblName), IncLbl, hipe_rtl:mk_move(UsedBytes, hipe_rtl:mk_imm(256)), AllLbl, allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize), - put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), + put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), Unit, TrueLblName, FalseLblName)]. allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> @@ -397,16 +411,6 @@ allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> hipe_tagscheme:mk_sub_binary(Dst, EndSubSize, Zero, EndSubBitSize, Zero, hipe_rtl:mk_imm(1), ProcBin)]. -check_and_untag_fixnum(Size, SizeReg, FalseLblName) -> - [ContLbl,NextLbl] = Lbls = create_lbls(2), - [ContLblName,NextLblName] = get_label_names(Lbls), - [hipe_tagscheme:test_fixnum(Size, ContLblName, FalseLblName, 0.99), - ContLbl, - hipe_tagscheme:untag_fixnum(SizeReg,Size), - hipe_rtl:mk_branch(SizeReg, ge, hipe_rtl:mk_imm(0), NextLblName, - FalseLblName), - NextLbl]. - realloc_binary(SizeReg, ProcBin, Base) -> [NoReallocLbl, ReallocLbl, NextLbl, ContLbl] = Lbls = create_lbls(4), [NoReallocLblName, ReallocLblName, NextLblName, ContLblName] = @@ -428,7 +432,7 @@ realloc_binary(SizeReg, ProcBin, Base) -> set_field_from_term(ProcBinFlagsTag, ProcBin, Flags), get_field_from_term(ProcBinValTag, ProcBin, BinPointer), get_field_from_pointer(BinOrigSizeTag, BinPointer, OrigSize), - hipe_rtl:mk_branch(OrigSize, 'lt', ResultingSize, + hipe_rtl:mk_branch(OrigSize, 'ltu', ResultingSize, ReallocLblName, NoReallocLblName), NoReallocLbl, get_field_from_term(ProcBinBytesTag, ProcBin, Base), @@ -669,14 +673,14 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName WordSize = hipe_rtl_arch:word_size(), [ContLbl,HeapLbl,REFCLbl,NextLbl] = create_lbls(4), [USize,Tmp] = create_unsafe_regs(2), - [get_32_bit_value(Size, USize, SystemLimitLblName, FalseLblName), - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_BINSIZE), - hipe_rtl:label_name(ContLbl), - SystemLimitLblName), + [get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), + hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_BINSIZE), + hipe_rtl:label_name(ContLbl), + SystemLimitLblName), ContLbl, hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)), - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), - hipe_rtl:label_name(HeapLbl), + hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), + hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, hipe_rtl:mk_alu(Tmp, USize, add, hipe_rtl:mk_imm(3*WordSize-1)), @@ -694,8 +698,8 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName hipe_rtl:mk_goto(TrueLblName)]. var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) -> - [HeapLbl,REFCLbl,NextLbl,NoSubLbl,SubLbl,ContLbl, - NoCreateSubBin, CreateSubBin, JoinLbl, JoinLbl2] = create_lbls(10), + [HeapLbl,REFCLbl,NextLbl,NoSubLbl,SubLbl, + NoCreateSubBin, CreateSubBin, JoinLbl, JoinLbl2] = create_lbls(9), [USize,ByteSize,TotByteSize,OffsetBits] = create_regs(4), [TmpDst] = create_unsafe_regs(1), Log2WordSize = hipe_rtl_arch:log2_word_size(), @@ -705,7 +709,7 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl ?PROC_BIN_WORDSIZE) + ?SUB_BIN_WORDSIZE, Zero = hipe_rtl:mk_imm(0), [hipe_rtl:mk_gctest(MaximumWords), - get_32_bit_value(Size, USize, SystemLimitLblName, FalseLblName), + get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), hipe_rtl:mk_alu(ByteSize, USize, srl, ?BYTE_SHIFT), hipe_rtl:mk_alub(OffsetBits, USize, 'and', ?LOW_BITS, eq, hipe_rtl:label_name(NoSubLbl), @@ -716,11 +720,7 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl SubLbl, hipe_rtl:mk_alu(TotByteSize, ByteSize, 'add', hipe_rtl:mk_imm(1)), JoinLbl, - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_BINSIZE), - hipe_rtl:label_name(ContLbl), - SystemLimitLblName), - ContLbl, - hipe_rtl:mk_branch(TotByteSize, 'le', hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), + hipe_rtl:mk_branch(TotByteSize, 'leu', hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, @@ -743,13 +743,16 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl hipe_rtl:mk_move(Dst, TmpDst), hipe_rtl:mk_goto(TrueLblName)]. -put_binary_all(NewOffset, Src, Base, Offset, TLName, FLName) -> +put_binary_all(NewOffset, Src, Base, Offset, Unit, TLName, FLName) -> [SrcBase,SrcOffset,NumBits] = create_regs(3), + [ContLbl] = create_lbls(1), CCode = binary_c_code(NewOffset, Src, Base, Offset, NumBits, TLName), AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, NumBits, Base, Offset, NewOffset, TLName), - get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName) ++ - test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode). + [get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName), + is_divisible(NumBits, Unit, hipe_rtl:label_name(ContLbl), FLName), + ContLbl + |test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode)]. test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode) -> [Tmp] = create_regs(1), @@ -976,7 +979,7 @@ copy_string(StringBase, StringSize, BinBase, BinOffset, NewOffset, TrueLblName) small_check(SizeVar, CopySize, FalseLblName) -> SuccessLbl = hipe_rtl:mk_new_label(), - [hipe_rtl:mk_branch(SizeVar, le, CopySize, + [hipe_rtl:mk_branch(SizeVar, leu, CopySize, hipe_rtl:label_name(SuccessLbl), FalseLblName), SuccessLbl]. @@ -1279,89 +1282,18 @@ copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, var) -> hipe_tagscheme:test_flonum(Src, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99) ++ [SuccessLbl|copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, pass)]. -make_size(1, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - {first_part(BitsVar, DstReg, FalseLblName), DstReg}; -make_size(?BYTE_SIZE, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - Code = - first_part(BitsVar, DstReg, FalseLblName) ++ - [hipe_rtl:mk_alu(DstReg, DstReg, 'sll', ?BYTE_SHIFT)], - {Code, DstReg}; -make_size(UnitImm, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - UnitList = number2list(UnitImm), - Code = multiply_code(UnitList, BitsVar, DstReg, FalseLblName), - {Code, DstReg}. - -multiply_code(List=[Head|_Tail], Variable, Result, FalseLblName) -> - Test = set_high(Head), - Tmp1 = hipe_rtl:mk_new_reg(), - SuccessLbl = hipe_rtl:mk_new_label(), - Register = hipe_rtl:mk_new_reg(), - Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| - first_part(Variable, Register, FalseLblName)] - ++ - [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), - 'eq', hipe_rtl:label_name(SuccessLbl), - FalseLblName, 0.99), - SuccessLbl], - multiply_code(List, Register, Result, FalseLblName, Tmp1, Code). - -multiply_code([ShiftSize|Rest], Register, Result, FalseLblName, Tmp1, OldCode) -> - SuccessLbl = hipe_rtl:mk_new_label(), - Code = OldCode ++ [hipe_rtl:mk_alu(Tmp1, Register, 'sll', - hipe_rtl:mk_imm(ShiftSize)), - hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99), - SuccessLbl], - multiply_code(Rest, Register, Result, FalseLblName, Tmp1, Code); -multiply_code([], _Register, _Result, _FalseLblName, _Tmp1, Code) -> - Code. - -number2list(X) when is_integer(X), X >= 0 -> - number2list(X, []). - -number2list(1, Acc) -> - lists:reverse([0|Acc]); -number2list(0, Acc) -> - lists:reverse(Acc); -number2list(X, Acc) -> - F = floorlog2(X), - number2list(X-(1 bsl F), [F|Acc]). - -floorlog2(X) -> - round(math:log(X)/math:log(2)-0.5). - -set_high(X) -> - set_high(X, 0). - -set_high(0, Y) -> - Y; -set_high(X, Y) -> - set_high(X-1, Y+(1 bsl (27-X))). - -get_32_bit_value(Size, USize, SystemLimitLblName, NegLblName) -> - Lbls = [FixLbl, BigLbl, OkLbl, PosBigLbl] = create_lbls(4), - [FixLblName, BigLblName, OkLblName, PosBigLblName] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls], - [hipe_tagscheme:test_fixnum(Size, FixLblName, BigLblName, 0.99), - FixLbl, - hipe_tagscheme:untag_fixnum(USize, Size), - hipe_rtl:mk_branch(USize, ge, hipe_rtl:mk_imm(0), OkLblName, NegLblName), - BigLbl, - hipe_tagscheme:test_pos_bignum(Size, PosBigLblName, NegLblName, 0.99), - PosBigLbl, - hipe_tagscheme:get_one_word_pos_bignum(USize, Size, SystemLimitLblName), - OkLbl]. - - -first_part(Var, Register, FalseLblName) -> - [SuccessLbl1, SuccessLbl2] = create_lbls(2), - [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(SuccessLbl1), - FalseLblName, 0.99), - SuccessLbl1, - hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), - hipe_rtl:label_name(SuccessLbl2), FalseLblName, 0.99), - SuccessLbl2, - hipe_tagscheme:untag_fixnum(Register, Var)]. - - +is_divisible(_Dividend, 1, SuccLbl, _FailLbl) -> + [hipe_rtl:mk_goto(SuccLbl)]; +is_divisible(Dividend, Divisor, SuccLbl, FailLbl) -> + Log2 = floorlog2(Divisor), + case Divisor =:= 1 bsl Log2 of + true -> %% Divisor is a power of 2 + %% Test that the Log2-1 lowest bits are clear + Mask = hipe_rtl:mk_imm(Divisor - 1), + [Tmp] = create_regs(1), + [hipe_rtl:mk_alub(Tmp, Dividend, 'and', Mask, eq, SuccLbl, FailLbl, 0.99)]; + false -> + %% We need division, fall back to a primop + [hipe_rtl:mk_call([], is_divisible, [Dividend, hipe_rtl:mk_imm(Divisor)], + SuccLbl, FailLbl, not_remote)] + end. diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index 51213b71d1..be4c35dae0 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -31,11 +31,12 @@ -import(hipe_tagscheme, [set_field_from_term/3, get_field_from_term/3]). +-import(hipe_rtl_binary, [make_size/3]). + -include("hipe_literals.hrl"). %%-------------------------------------------------------------------- --define(MAX_BINSIZE, trunc(?MAX_HEAP_BIN_SIZE / hipe_rtl_arch:word_size()) + 2). -define(BYTE_SHIFT, 3). %% Turn bits into bytes or vice versa -define(LOW_BITS, 7). %% Three lowest bits set -define(BYTE_SIZE, 8). @@ -333,32 +334,50 @@ float_get_c_code(Dst1, Ms, Size, Flags, TrueLblName, FalseLblName) -> get_c_code(Func, Dst1, Ms, Size, Flags, TrueLblName, FalseLblName) -> SizeReg = hipe_rtl:mk_new_reg_gcsafe(), FlagsReg = hipe_rtl:mk_new_reg_gcsafe(), + RetReg = hipe_rtl:mk_new_reg_gcsafe(), MatchBuf = hipe_rtl:mk_new_reg(), RetLabel = hipe_rtl:mk_new_label(), + OkLabel = hipe_rtl:mk_new_label(), NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()), [hipe_rtl:mk_move(SizeReg, Size), hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)), hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms), - hipe_rtl_arch:call_bif([Dst1], Func, [SizeReg, FlagsReg, MatchBuf], + hipe_rtl_arch:call_bif([RetReg], Func, [SizeReg, FlagsReg, MatchBuf], hipe_rtl:label_name(RetLabel), FalseLblName), RetLabel, - hipe_rtl:mk_branch(Dst1, eq, NonVal, FalseLblName, TrueLblName, 0.01)]. + hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName, + hipe_rtl:label_name(OkLabel), 0.01), + OkLabel, + hipe_rtl:mk_move(Dst1, RetReg), + hipe_rtl:mk_goto(TrueLblName)]. utf8_get_c_code(Dst, Ms, TrueLblName, FalseLblName) -> + RetReg = hipe_rtl:mk_new_reg_gcsafe(), + OkLabel = hipe_rtl:mk_new_label(), MatchBuf = hipe_rtl:mk_new_reg(), NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()), [hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms), - hipe_rtl_arch:call_bif([Dst], bs_get_utf8, [MatchBuf], [], []), - hipe_rtl:mk_branch(Dst, eq, NonVal, FalseLblName, TrueLblName, 0.01)]. + hipe_rtl_arch:call_bif([RetReg], bs_get_utf8, [MatchBuf], [], []), + hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName, + hipe_rtl:label_name(OkLabel), 0.01), + OkLabel, + hipe_rtl:mk_move(Dst, RetReg), + hipe_rtl:mk_goto(TrueLblName)]. utf16_get_c_code(Flags, Dst, Ms, TrueLblName, FalseLblName) -> + RetReg = hipe_rtl:mk_new_reg_gcsafe(), + OkLabel = hipe_rtl:mk_new_label(), MatchBuf = hipe_rtl:mk_new_reg(), NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()), FlagsReg = hipe_rtl:mk_new_reg_gcsafe(), [hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms), hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)), - hipe_rtl_arch:call_bif([Dst], bs_get_utf16, [MatchBuf, FlagsReg], [], []), - hipe_rtl:mk_branch(Dst, eq, NonVal, FalseLblName, TrueLblName, 0.01)]. + hipe_rtl_arch:call_bif([RetReg], bs_get_utf16, [MatchBuf, FlagsReg], [], []), + hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName, + hipe_rtl:label_name(OkLabel), 0.01), + OkLabel, + hipe_rtl:mk_move(Dst, RetReg), + hipe_rtl:mk_goto(TrueLblName)]. validate_unicode_retract_c_code(Src, Ms, TrueLblName, FalseLblName) -> MatchBuf = hipe_rtl:mk_new_reg(), @@ -817,10 +836,10 @@ create_lbls(0) -> create_lbls(X) when X > 0 -> [hipe_rtl:mk_new_label()|create_lbls(X-1)]. -make_dyn_prep(SizeReg, CCode) -> +make_dyn_prep(SizeReg, CCode) -> [CLbl, SuccessLbl] = create_lbls(2), - Init = [hipe_rtl:mk_branch(SizeReg, le, hipe_rtl:mk_imm(?MAX_SMALL_BITS), - hipe_rtl:label_name(SuccessLbl), + Init = [hipe_rtl:mk_branch(SizeReg, leu, hipe_rtl:mk_imm(?MAX_SMALL_BITS), + hipe_rtl:label_name(SuccessLbl), hipe_rtl:label_name(CLbl)), SuccessLbl], End = [CLbl|CCode], @@ -865,8 +884,8 @@ get_unaligned_int_to_reg(Reg, Size, Base, Offset, LowBits, Shiftr, Type) -> hipe_rtl:mk_imm((WordSize-MinLoad)*?BYTE_SIZE))]; {_, WordSize} -> UnsignedBig = {unsigned, big}, - [hipe_rtl:mk_branch(TotBits, le, hipe_rtl:mk_imm(MinLoad*?BYTE_SIZE), - hipe_rtl:label_name(LessLbl), + [hipe_rtl:mk_branch(TotBits, leu, hipe_rtl:mk_imm(MinLoad*?BYTE_SIZE), + hipe_rtl:label_name(LessLbl), hipe_rtl:label_name(MoreLbl)), LessLbl, load_bytes(LoadDst, Base, ByteOffset, Type, MinLoad), @@ -926,7 +945,7 @@ get_big_unknown_int(Dst1, Base, Offset, NewOffset, hipe_rtl:mk_alu(ByteOffset, Offset, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)), load_bytes(LoadDst, Base, ByteOffset, Type, 1), BackLbl, - hipe_rtl:mk_branch(ByteOffset, le, Limit, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(ByteOffset, leu, Limit, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), LoopLbl, load_bytes(Tmp, Base, ByteOffset, {unsigned, big}, 1), @@ -955,8 +974,8 @@ get_little_unknown_int(Dst1, Base, Offset, NewOffset, hipe_rtl:mk_alu(Limit, Tmp, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)), hipe_rtl:mk_move(ShiftReg, hipe_rtl:mk_imm(0)), BackLbl, - hipe_rtl:mk_branch(ByteOffset, lt, Limit, - hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(ByteOffset, ltu, Limit, + hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(DoneLbl)), LoopLbl, load_bytes(Tmp, Base, ByteOffset, {unsigned, big}, 1), @@ -1072,7 +1091,7 @@ load_bytes(Dst, Base, Offset, {Signedness, Endianness}, X) when X > 1 -> hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)), hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)), hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1), - hipe_rtl:mk_branch(Offset, lt, Limit, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(Offset, ltu, Limit, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), EndLbl]; little -> @@ -1084,7 +1103,7 @@ load_bytes(Dst, Base, Offset, {Signedness, Endianness}, X) when X > 1 -> hipe_rtl:mk_load(Tmp1, Base, TmpOffset, byte, Signedness), hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)), hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1), - hipe_rtl:mk_branch(Offset, lt, TmpOffset, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(Offset, ltu, TmpOffset, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), EndLbl, hipe_rtl:mk_move(Offset, Limit)] @@ -1100,103 +1119,5 @@ create_gcsafe_regs(X) when X > 0 -> create_gcsafe_regs(0) -> []. -first_part(Var, Register, FalseLblName) -> - [EndLbl] = create_lbls(1), - EndName = hipe_rtl:label_name(EndLbl), - first_part(Var, Register, FalseLblName, EndName, EndName, [EndLbl]). - -first_part(Var, Register, FalseLblName, TrueLblName, BigLblName, Tail) -> - [FixnumLbl, NotFixnumLbl, BignumLbl, SuccessLbl] = create_lbls(4), - [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(FixnumLbl), - hipe_rtl:label_name(NotFixnumLbl), 0.99), - FixnumLbl, - hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), - hipe_rtl:label_name(SuccessLbl), FalseLblName, - 0.99), - SuccessLbl, - hipe_tagscheme:untag_fixnum(Register, Var), - hipe_rtl:mk_goto(TrueLblName), - NotFixnumLbl, - %% Since binaries are not allowed to be larger than 2^wordsize bits - %% and since bignum digits are words, we know that a bignum with an - %% arity larger than one can't match. - hipe_tagscheme:test_pos_bignum_arity(Var, 1, hipe_rtl:label_name(BignumLbl), - FalseLblName, 0.99), - BignumLbl, - hipe_tagscheme:unsafe_get_one_word_pos_bignum(Register, Var), - hipe_rtl:mk_goto(BigLblName) | Tail]. - -make_size(1, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - {first_part(BitsVar, DstReg, FalseLblName), DstReg}; -make_size(?BYTE_SIZE, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - [FixnumLbl, BignumLbl] = create_lbls(2), - WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, - FixnumLblName = hipe_rtl:label_name(FixnumLbl), - Tail = [BignumLbl, - hipe_rtl:mk_branch(DstReg, 'ltu', - hipe_rtl:mk_imm(1 bsl (WordBits - ?BYTE_SHIFT)), - FixnumLblName, FalseLblName, 0.99), - FixnumLbl, - hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))], - Code = first_part(BitsVar, DstReg, FalseLblName, FixnumLblName, - hipe_rtl:label_name(BignumLbl), Tail), - {Code, DstReg}; -make_size(UnitImm, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - UnitList = number2list(UnitImm), - Code = multiply_code(UnitList, BitsVar, DstReg, FalseLblName), - {Code, DstReg}. - -multiply_code(List=[Head|_Tail], Variable, Result, FalseLblName) -> - Test = set_high(Head), - Tmp1 = hipe_rtl:mk_new_reg(), - SuccessLbl = hipe_rtl:mk_new_label(), - Register = hipe_rtl:mk_new_reg(), - Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| - first_part(Variable, Register, FalseLblName)] - ++ - [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), - eq, hipe_rtl:label_name(SuccessLbl), - FalseLblName, 0.99), - SuccessLbl], - multiply_code(List, Register, Result, FalseLblName, Tmp1, Code). - -multiply_code([ShiftSize|Rest], Register, Result, FalseLblName, Tmp1, OldCode) -> - SuccessLbl = hipe_rtl:mk_new_label(), - Code = - OldCode ++ - [hipe_rtl:mk_alu(Tmp1, Register, sll, hipe_rtl:mk_imm(ShiftSize)), - hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, - hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99), - SuccessLbl], - multiply_code(Rest, Register, Result, FalseLblName, Tmp1, Code); -multiply_code([], _Register, _Result, _FalseLblName, _Tmp1, Code) -> - Code. - -number2list(X) when is_integer(X), X >= 0 -> - number2list(X, []). - -number2list(1, Acc) -> - lists:reverse([0|Acc]); -number2list(0, Acc) -> - lists:reverse(Acc); -number2list(X, Acc) -> - F = floorlog2(X), - number2list(X-(1 bsl F), [F|Acc]). - -floorlog2(X) -> - round(math:log(X)/math:log(2)-0.5). - -set_high(X) -> - WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, - set_high(min(X, WordBits), WordBits, 0). - -set_high(0, _, Y) -> - Y; -set_high(X, WordBits, Y) -> - set_high(X-1, WordBits, Y+(1 bsl (WordBits-X))). - is_illegal_const(Const) -> Const >= 1 bsl (hipe_rtl_arch:word_size() * ?BYTE_SIZE) orelse Const < 0. diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl index d77078acb6..8825a3ade3 100644 --- a/lib/hipe/rtl/hipe_tagscheme.erl +++ b/lib/hipe/rtl/hipe_tagscheme.erl @@ -42,7 +42,7 @@ test_ref/4, test_fun/4, test_fun2/5, test_matchstate/4, test_binary/4, test_bitstr/4, test_list/4, test_map/4, test_integer/4, test_number/4, test_tuple_N/5, - test_pos_bignum_arity/5]). + test_pos_bignum_arity/6]). -export([realtag_fixnum/2, tag_fixnum/2, realuntag_fixnum/2, untag_fixnum/2]). -export([test_two_fixnums/3, test_fixnums/4, unsafe_fixnum_add/3, unsafe_fixnum_sub/3, @@ -351,14 +351,23 @@ test_pos_bignum(X, TrueLab, FalseLab, Pred) -> mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG, TrueLab, FalseLab, Pred)]. -test_pos_bignum_arity(X, Arity, TrueLab, FalseLab, Pred) -> +test_pos_bignum_arity(X, Arity, TrueLab, NotPosBignumLab, FalseLab, Pred) -> Tmp = hipe_rtl:mk_new_reg_gcsafe(), - HalfTrueLab = hipe_rtl:mk_new_label(), + BoxedLab = hipe_rtl:mk_new_label(), HeaderImm = hipe_rtl:mk_imm(mk_header(Arity, ?TAG_HEADER_POS_BIG)), - [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred), - HalfTrueLab, - get_header(Tmp, X), - hipe_rtl:mk_branch(Tmp, 'eq', HeaderImm, TrueLab, FalseLab, Pred)]. + [test_is_boxed(X, hipe_rtl:label_name(BoxedLab), NotPosBignumLab, Pred), + BoxedLab, + get_header(Tmp, X)] ++ + case NotPosBignumLab =:= FalseLab of + true -> []; + false -> + BignumLab = hipe_rtl:mk_new_label(), + BigMask = ?TAG_HEADER_MASK, + [mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG, + hipe_rtl:label_name(BignumLab), NotPosBignumLab, Pred), + BignumLab] + end ++ + [hipe_rtl:mk_branch(Tmp, 'eq', HeaderImm, TrueLab, FalseLab, Pred)]. test_matchstate(X, TrueLab, FalseLab, Pred) -> Tmp = hipe_rtl:mk_new_reg_gcsafe(), diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile index 009f503abb..d781e4f9be 100644 --- a/lib/hipe/test/Makefile +++ b/lib/hipe/test/Makefile @@ -10,8 +10,10 @@ MODULES= \ # .erl files for these modules are automatically generated GEN_MODULES= \ + basic_SUITE \ bs_SUITE \ - maps_SUITE + maps_SUITE \ + sanity_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/hipe/test/basic_SUITE_data/basic_arith.erl b/lib/hipe/test/basic_SUITE_data/basic_arith.erl new file mode 100644 index 0000000000..28e99be053 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_arith.erl @@ -0,0 +1,72 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%--------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests cases for compilation of arithmetic. +%%%--------------------------------------------------------------------- +-module(basic_arith). + +-export([test/0]). + +test() -> + ok = test_rem(), + ok = test_bit_ops(), + ok = test_uplus(), + ok = test_bsl_errors(), + ok. + +%%---------------------------------------------------------------------- +%% Tests the remainder operator. + +test_rem() -> + 2 = ret_rem(42, 20), + -2 = ret_rem(-42, 20), + -2 = ret_rem(-42, -20), + {'EXIT', {badarith, _}} = ret_rem(3.14, 2), + {'EXIT', {badarith, _}} = ret_rem(42, 3.14), + ok. + +ret_rem(X, Y) -> + catch X rem Y. + +%%---------------------------------------------------------------------- +%% + +test_bit_ops() -> + 2 = bbb(11, 2, 16#3ff), + ok. + +bbb(X, Y, Z) -> + ((1 bsl X) bor Y) band Z. + +%%---------------------------------------------------------------------- +%% Tests unary plus: it used to be the identity function but not anymore + +test_uplus() -> + badarith = try uplus(gazonk) catch error:Err -> Err end, + 42 = uplus(42), + ok. + +uplus(X) -> +(X). + +%%---------------------------------------------------------------------- +%% The first part of this test triggered a bug in the emulator as one +%% of the arguments to bsl is not an integer. +%% +%% The second part triggered a compilation crash since an arithmetic +%% expression resulting in a 'system_limit' exception was statically +%% evaluated and an arithmetic result was expected. + +test_bsl_errors() -> + {'EXIT', {'badarith', _}} = (catch (t1(0, pad, 0))), + badarith = try t2(0, pad, 0) catch error:Err1 -> Err1 end, + system_limit = try (id(1) bsl 100000000) catch error:Err2 -> Err2 end, + ok. + +t1(_, X, _) -> + (1 bsl X) + 1. + +t2(_, X, _) -> + (X bsl 1) + 1. + +id(I) -> I. diff --git a/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl new file mode 100644 index 0000000000..6fafea3b09 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl @@ -0,0 +1,102 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests for correct translation of various BEAM instructions. +%%%------------------------------------------------------------------- +-module(basic_beam_instrs). + +-export([test/0]). + +test() -> + ok = test_make_fun(), + ok = test_switch_val(), + ok = test_put_literal(), + ok = test_set_tuple_element(), + ok = test_unguarded_unsafe_element(), + ok. + +%%-------------------------------------------------------------------- +%% Tests whether the translation of make_fun works. + +test_make_fun() -> + {F, G} = double_the_fun(), + ok = F(), + {ok, 42} = G(42), + FV1 = {ok, free_var1}, + FV2 = {also, {free, var2}}, + {FV1, {ok, [bv]}, FV2} = contains_fun(FV1, ignored, FV2), + ok. + +double_the_fun() -> + {fun () -> ok end, fun (V) -> {ok, V} end}. + +contains_fun(X, _IGNORED_ARG, Y) -> + calls_fun(fun(Term) -> {X, Term, Y} end). + +calls_fun(F) -> + F({ok, [bv]}). + +%%-------------------------------------------------------------------- +%% Tests whether the translation of switch_val works. + +test_switch_val() -> + 'A' = sv(a), + 'B' = sv(b), + 'C' = sv(c), + foo = sv(d), + ok. + +sv(a) -> 'A'; +sv(b) -> 'B'; +sv(c) -> 'C'; +sv(_) -> foo. + +%%-------------------------------------------------------------------- +%% Tests correct handling of literals (statically constant terms) + +-define(QUADRUPLE, {a,b,c,42}). +-define(DEEP_LIST, [42,[42,[42]]]). + +test_put_literal() -> + ?QUADRUPLE = mk_literal_quadruple(), + ?DEEP_LIST = mk_literal_deep_list(), + ok. + +mk_literal_quadruple() -> + ?QUADRUPLE. + +mk_literal_deep_list() -> + ?DEEP_LIST. + +%%-------------------------------------------------------------------- +%% Tests whether the translation of set_tuple_element works. + +-record(rec, {f1, f2, f3, f4, f5}). + +test_set_tuple_element() -> + F2 = [a,b,c], F4 = {a,b}, + State0 = init_rec(F2, F4), + State1 = simple_set(State0, 42), + #rec{f1 = foo, f2 = F2, f3 = 42, f4 = F4, f5 = 42.0} = odd_set(State1, 21), + ok. + +init_rec(F2, F4) -> + #rec{f1 = bar, f2 = F2, f3 = 10, f4 = F4, f5 = 3.14}. + +simple_set(State, Val) -> %% f3 = Val is the one used in set_element; + State#rec{f3 = Val, f5 = Val*2}. %% this checks the case of variable + +odd_set(State, Val) -> %% f3 = foo is the one used in set_element; + State#rec{f1 = foo, f5 = Val*2.0}. %% this checks the case of constant + +%%-------------------------------------------------------------------- +%% Tests the handling of unguarded unsafe_element operations that BEAM +%% can sometimes construct on records (when it has enough context). + +test_unguarded_unsafe_element() -> + {badrecord, rec} = try unguarded_unsafe_element(42) catch error:E -> E end, + ok. + +unguarded_unsafe_element(X) -> + X#rec{f1 = X#rec.f3}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_bifs.erl b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl new file mode 100644 index 0000000000..e7ee2f3678 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl @@ -0,0 +1,257 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for handling of BIFs in guards and body calls. +%%%------------------------------------------------------------------- +-module(basic_bifs). + +-export([test/0]). + +-define(BIG, 1398479237498374913984792374983749). + +test() -> + ok = test_abs(), + ok = test_binary_part(), + ok = test_element(), + ok = test_float(), + ok = test_float_to_list(), + ok = test_integer_to_list(), + ok = test_list_to_float(), + ok = test_list_to_integer(), + ok = test_round(), + ok = test_trunc(), + ok. + +%%-------------------------------------------------------------------- + +test_abs() -> + t_abs(5.5, 0.0, -100.0, 5, 0, -100, ?BIG). + +t_abs(F1, F2, F3, I1, I2, I3, BigNum) -> + %% Floats. + 5.5 = abs(F1), + 0.0 = abs(F2), + 100.0 = abs(F3), + %% Integers. + 5 = abs(I1), + 0 = abs(I2), + 100 = abs(I3), + %% Bignums. + BigNum = abs(BigNum), + BigNum = abs(-BigNum), + ok. + +%%-------------------------------------------------------------------- +%% Checks that 2-ary and 3-ary BIFs can be compiled to native code. + +test_binary_part() -> + Bin = <<1,2,3,4,5,6,7,8,9,10>>, + BinPart = bp3(Bin), + <<7,8>> = bp2(BinPart), + ok. + +bp2(Bin) -> + binary_part(Bin, {1, 2}). + +bp3(Bin) -> + binary_part(Bin, byte_size(Bin), -5). + +%%-------------------------------------------------------------------- + +test_element() -> + true = elem({a, b}), + false = elem({a, c}), + other = elem(gazonk), + ok. + +elem(T) when element(1, T) == a -> element(2, T) == b; +elem(_) -> other. + +%%-------------------------------------------------------------------- + +test_float() -> + t_float(0, 42, -100, 2.5, 0.0, -100.42, ?BIG, -?BIG). + +t_float(I1, I2, I3, F1, F2, F3, B1, B2) -> + 0.0 = float(I1), + 2.5 = float(F1), + 0.0 = float(F2), + -100.42 = float(F3), + 42.0 = float(I2), + -100.0 = float(I3), + %% Bignums. + 1398479237498374913984792374983749.0 = float(B1), + -1398479237498374913984792374983749.0 = float(B2), + %% Extremly big bignums. + Big = list_to_integer(duplicate(2000, $1)), + {'EXIT', _} = (catch float(Big)), + %% Invalid types and lists. + {'EXIT', _} = (catch my_list_to_integer(atom)), + {'EXIT', _} = (catch my_list_to_integer(123)), + {'EXIT', _} = (catch my_list_to_integer([$1, [$2]])), + {'EXIT', _} = (catch my_list_to_integer("1.2")), + {'EXIT', _} = (catch my_list_to_integer("a")), + {'EXIT', _} = (catch my_list_to_integer("")), + ok. + +my_list_to_integer(X) -> + list_to_integer(X). + +%%-------------------------------------------------------------------- + +test_float_to_list() -> + test_ftl("0.0e+0", 0.0), + test_ftl("2.5e+1", 25.0), + test_ftl("2.5e+0", 2.5), + test_ftl("2.5e-1", 0.25), + test_ftl("-3.5e+17", -350.0e15), + ok. + +test_ftl(Expect, Float) -> + %% No \n on the next line -- we want the line number from t_float_to_list. + Expect = remove_zeros(lists:reverse(float_to_list(Float)), []). + +%% Removes any non-significant zeros in a floating point number. +%% Example: 2.500000e+01 -> 2.5e+1 + +remove_zeros([$+, $e|Rest], [$0, X|Result]) -> + remove_zeros([$+, $e|Rest], [X|Result]); +remove_zeros([$-, $e|Rest], [$0, X|Result]) -> + remove_zeros([$-, $e|Rest], [X|Result]); +remove_zeros([$0, $.|Rest], [$e|Result]) -> + remove_zeros(Rest, [$., $0, $e|Result]); +remove_zeros([$0|Rest], [$e|Result]) -> + remove_zeros(Rest, [$e|Result]); +remove_zeros([Char|Rest], Result) -> + remove_zeros(Rest, [Char|Result]); +remove_zeros([], Result) -> + Result. + +%%-------------------------------------------------------------------- + +test_integer_to_list() -> + t_integer_to_list(0, 42, 32768, 268435455, 123456932798748738738). + +t_integer_to_list(I1, I2, I3, I4, BIG) -> + "0" = integer_to_list(I1), + "42" = integer_to_list(I2), + "-42" = integer_to_list(-I2), + "-42" = integer_to_list(-I2), + "32768" = integer_to_list(I3), + "268435455" = integer_to_list(I4), + "-268435455" = integer_to_list(-I4), + "123456932798748738738" = integer_to_list(BIG), + BigList = duplicate(2000, $1), + Big = list_to_integer(BigList), + BigList = integer_to_list(Big), + ok. + +%%-------------------------------------------------------------------- + +test_list_to_float() -> + ok = t_list_to_float_safe(), + ok = t_list_to_float_risky(). + +t_list_to_float_safe() -> + 0.0 = my_list_to_float("0.0"), + 0.0 = my_list_to_float("-0.0"), + 0.5 = my_list_to_float("0.5"), + -0.5 = my_list_to_float("-0.5"), + 100.0 = my_list_to_float("1.0e2"), + 127.5 = my_list_to_float("127.5"), + -199.5 = my_list_to_float("-199.5"), + {'EXIT', _} = (catch my_list_to_float("0")), + {'EXIT', _} = (catch my_list_to_float("0..0")), + {'EXIT', _} = (catch my_list_to_float("0e12")), + {'EXIT', _} = (catch my_list_to_float("--0.0")), + ok. + +my_list_to_float(X) -> + list_to_float(X). + +%% This might crash the emulator. (Used to crash Erlang 4.4.1 on Unix.) + +t_list_to_float_risky() -> + Many_Ones = duplicate(25000, $1), + ok = case list_to_float("2." ++ Many_Ones) of + F when is_float(F), 0.0 < F, F =< 3.14 -> ok + end, + {'EXIT', _} = (catch list_to_float("2" ++ Many_Ones)), + ok. + +%%-------------------------------------------------------------------- + +test_list_to_integer() -> + ok = t_list_to_integer_small("0", "00", "-0", "1", "-1", "42", "-12", + "32768", "268435455", "-268435455"), + ok = t_list_to_integer_bignum("123456932798748738738666"), + ok. + +t_list_to_integer_small(S1, S2, S3, S4, S5, S6, S7, S8, S9, S10) -> + 0 = list_to_integer(S1), + 0 = list_to_integer(S2), + 0 = list_to_integer(S3), + 1 = list_to_integer(S4), + -1 = list_to_integer(S5), + 42 = list_to_integer(S6), + -12 = list_to_integer(S7), + 32768 = list_to_integer(S8), + 268435455 = list_to_integer(S9), + -268435455 = list_to_integer(S10), + ok. + +t_list_to_integer_bignum(S) -> + 123456932798748738738666 = list_to_integer(S), + case list_to_integer(duplicate(2000, $1)) of + I when is_integer(I), I > 123456932798748738738666 -> ok + end. + +%%-------------------------------------------------------------------- + +test_round() -> + ok = t_round_small(0.0, 0.4, 0.5, -0.4, -0.5, 255.3, 255.6, -1033.3, -1033.6), + ok = t_round_big(4294967296.1, 4294967296.9), + ok. + +t_round_small(F1, F2, F3, F4, F5, F6, F7, F8, F9) -> + 0 = round(F1), + 0 = round(F2), + 1 = round(F3), + 0 = round(F4), + -1 = round(F5), + 255 = round(F6), + 256 = round(F7), + -1033 = round(F8), + -1034 = round(F9), + ok. + +t_round_big(B1, B2) -> + 4294967296 = round(B1), + 4294967297 = round(B2), + -4294967296 = round(-B1), + -4294967297 = round(-B2), + ok. + +%%-------------------------------------------------------------------- + +test_trunc() -> + t_trunc(0.0, 5.3333, -10.978987, 4294967305.7). + +t_trunc(F1, F2, F3, B) -> + 0 = trunc(F1), + 5 = trunc(F2), + -10 = trunc(F3), + %% Bignums. + 4294967305 = trunc(B), + -4294967305 = trunc(-B), + ok. + +%%-------------------------------------------------------------------- +%% Auxiliary functions below + +duplicate(N, X) when is_integer(N), N >= 0 -> + duplicate(N, X, []). + +duplicate(0, _, L) -> L; +duplicate(N, X, L) -> duplicate(N-1, X, [X|L]). diff --git a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl new file mode 100644 index 0000000000..e3b523b3f5 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl @@ -0,0 +1,143 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that test bignum arithmetic and matching. +%%%------------------------------------------------------------------- +-module(basic_bignums). + +-export([test/0, test_bsl/0]). + +test() -> + ok = test_ops(), + ok = test_big_fac(), + ok = test_int_overfl_32(), + ok = test_int_overfl_64(), + ok = test_int_overfl_32_guard(), + ok = test_int_overfl_64_guard(), + ok. + +%%-------------------------------------------------------------------- +%% Define some constants for the tests of arithmetic operators + +-define(X, 68719476736). +-define(Y, 98765432101234). +-define(Z, 4722366482869645213696). +-define(W, 339254531512339254531512). + +-define(B1, 4398046511104). +-define(B5, 1645504557321206042154969182557350504982735865633579863348609024). +-define(B17, 86182066610968551542636378241108028056376767329454880514019834315878107616003372189510312530372009184902888961739623919010110377987011442493486117202360415845666384627768436296772219009176743399772868636439042064384). + +%%-------------------------------------------------------------------- + +test_ops() -> + ok = test_mult(), + ok = test_div(), + ok = test_round(), + ok = test_trunc(), + ok = test_bsl(), + ok. + +test_mult() -> + ?Z = mult(?X, ?X), + ok. + +mult(X, Y) -> X * Y. + +test_div() -> + 4 = div_f(339254531512, ?X), + 0 = div_f(?Y, ?Y+1), + 64 = div_f(?B1, ?X), + ?X = div_f(?Z, ?X), + 1073741824 = div_f(?Z, ?B1), + ok. + +div_f(X, Y) -> X div Y. + +test_round() -> + 0 = round_f(?Z, ?W), + 1 = round_f(?Y, ?Y), + 71 = round_f(?W, ?Z), + 1437 = round_f(?Y, ?X), + 47813960 = round_f(?Z, ?Y), + 4936803183406 = round_f(?W, ?X), + ok. + +trunc_f(X, Y) -> round(X/Y). + +test_trunc() -> + 0 = trunc_f(?Z, ?W), + 1 = trunc_f(?Y, ?Y), + 72 = trunc_f(?W, ?Z), + 1437 = trunc_f(?Y, ?X), + 47813961 = trunc_f(?Z, ?Y), + 4936803183407 = trunc_f(?W, ?X), + ok. + +round_f(X, Y) -> trunc(X/Y). + +test_bsl() -> + ?B1 = bsl_f(1, 42), + ?B5 = n(5, fun erlang:'bsl'/2, 1, 42), % use the operator + ?B17 = n(17, fun bsl_f/2, 1, 42), % use the local function + ok. + +bsl_f(X, Y) -> X bsl Y. + +%% applies a binary function N times +n(1, F, X, Y) -> F(X, Y); +n(N, F, X, Y) when N > 1 -> n(N-1, F, F(X, Y), Y). + +%%-------------------------------------------------------------------- + +-define(FAC42, 1405006117752879898543142606244511569936384000000000). + +test_big_fac() -> + ?FAC42 = fac(42), + ok. + +fac(0) -> 1; +fac(N) -> N * fac(N-1). + +%%-------------------------------------------------------------------- +%% Tests for correct handling of integer overflow + +test_int_overfl_32() -> + 16#7FFFFFF = add(16#7FFFFFF, 0), + 16#8000000 = add(16#8000000, 0), + 16#8000001 = add(16#8000000, 1), + case add(16#7FFFFFF, 1) of + 16#8000000 -> ok; + -16#7FFFFFF -> error + end. + +test_int_overfl_64() -> + 16#7FFFFFFFFFFFFFF = add(16#7FFFFFFFFFFFFFF, 0), + 16#800000000000000 = add(16#800000000000000, 0), + 16#800000000000001 = add(16#800000000000000, 1), + case add(16#7FFFFFFFFFFFFFF, 1) of + 16#800000000000000 -> ok; + -16#7FFFFFFFFFFFFFF -> error + end. + +add(X, Y) -> X + Y. + +%%-------------------------------------------------------------------- +%% Tests for correct handling of integer overflow in guards + +test_int_overfl_32_guard() -> + ok = overfl_in_guard(16#7ffffff, 0), + ok = overfl_in_guard(16#7ffffff, 16#7ffffff), + ok. + +test_int_overfl_64_guard() -> + ok = overfl_in_guard(16#7ffffffffffffff, 0), + ok = overfl_in_guard(16#7ffffffffffffff, 16#7ffffffffffffff), + ok. + +overfl_in_guard(X, Y) -> + case ok of + V when X+Y > 12 -> V; + _ -> bad + end. diff --git a/lib/hipe/test/basic_SUITE_data/basic_boolean.erl b/lib/hipe/test/basic_SUITE_data/basic_boolean.erl new file mode 100644 index 0000000000..e4a91ef5af --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_boolean.erl @@ -0,0 +1,47 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests for correct translation of booleans and their primitives. +%%%------------------------------------------------------------------- +-module(basic_boolean). + +-export([test/0]). + +test() -> + ok = test_boolean_ops(false, true), + ok = test_orelse_redundant(), + ok. + +%%-------------------------------------------------------------------- + +test_boolean_ops(F, T) -> + true = T and T, + false = T and F, + false = F and T, + false = F and F, + true = T or T, + true = T or F, + true = F or T, + false = F or F, + true = T andalso T, + false = T andalso F, + false = F andalso T, + false = F andalso F, + true = T orelse T, + true = T orelse F, + true = F orelse T, + false = F orelse F, + ok. + +%%-------------------------------------------------------------------- +%% Redundant test in BEAM code will generate type warning. + +test_orelse_redundant() -> + true = test_orelse(true, true, true), + ok. + +test_orelse(A, B, C) -> + A andalso B orelse C. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl new file mode 100644 index 0000000000..964b0f423a --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl @@ -0,0 +1,138 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that exhibited bugs in the BEAM compiler. +%%%------------------------------------------------------------------- +-module(basic_bugs_beam). + +-export([test/0]). + +%% the following is needed for the test_weird_message +-export([loop/1]). +%% the following are needed for the test_catch_bug +-behaviour(gen_server). +-export([start_link/1]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +test() -> + ok = test_fp_basic_blocks(), + ok = test_weird_message(), + ok = test_catch_bug(), + ok. + +%%-------------------------------------------------------------------- +%% Test which shows that BEAM's splitting of basic blocks should take +%% into account that arithmetic operations implemented as BIFs can +%% also cause exceptions and thus calls to BIFs should end basic blocks. +%% +%% Investigated and fixed in the beginning of April 2004. +%%-------------------------------------------------------------------- + +test_fp_basic_blocks() -> + ok = t1(), + ok = t2(). + +t1() -> + X = (catch bad_arith1(2.0, 1.7)), + case X of + {'EXIT', {badarith, _}} -> + ok; + _ -> + error + end. + +bad_arith1(X, Y) when is_float(X) -> + X1 = X * 1.7e+308, + X2 = X1 + 1.0, + Y1 = Y * 2, + {X2, Y1}. + +%% Similarly, it is not kosher to have anything that can fail inside +%% the fp block since it will throw the exception before the fp +%% exception and we will get the same problems. + +t2() -> + case catch bad_arith2(2.0, []) of + {'EXIT', {badarith, _}} -> + ok; + _ -> + error + end. + +bad_arith2(X, Y) when is_float(X) -> + X1 = X * 1.7e+308, + Y1 = element(1, Y), + {X1 + 1.0, Y1}. + +%%-------------------------------------------------------------------- +%% Sending 'test' to this process should return 'ok'. But: +%% +%% 1> MOD:test(). +%% Weird: received true +%% timeout +%% +%% Surprisingly, the message has been bound to the value of 'ena' +%% in the record! The problem was visible in the .S file. +%%-------------------------------------------------------------------- + +-record(state, {ena = true}). + +test_weird_message() -> + P = spawn_link(?MODULE, loop, [#state{}]), + P ! {msg, self()}, + receive + What -> What + after 42 -> timeout + end. + +loop(S) -> + receive + _ when S#state.ena == false -> + io:format("Weird: ena is false\n"); + % loop(S); + {msg, Pid} -> + Pid ! ok; + % loop(S); + Other -> + io:format("Weird: received ~p\n", [Other]) + % loop(S) + end. + +%%-------------------------------------------------------------------- +%% This was posted on the Erlang mailing list as a question: +%% +%% Given the module below and the function call +%% "catch_bug:start_link(foo)." +%% from the Erlang shell, why does Erlang crash with "Catch not found"? +%% +%% The BEAM compiler was generating wrong code for this case; +%% this was fixed in R9C-0. Native code generation was OK. +%%-------------------------------------------------------------------- + +test_catch_bug() -> + ignore = start_link(foo), + ok. + +start_link(Param) -> + gen_server:start_link(?MODULE, Param, []). + +init(Param) -> + process_flag(trap_exit, true), + (catch begin + dummy(Param), + (catch exit(bar)) + end + ), + ignore. + +dummy(_) -> ok. + +%% gen_server callbacks below +handle_call(_Call, _From, State) -> {noreply, State}. +handle_cast(_Msg, State) -> {noreply, State}. +handle_info(_Msg, State) -> {noreply, State}. +terminate(_Reason, _State) -> ok. +code_change(_OldVsn, State, _Extra) -> {ok, State}. + diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl new file mode 100644 index 0000000000..caa0e71d0b --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl @@ -0,0 +1,463 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%---------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that exhibited bugs in the HiPE compiler. +%%%---------------------------------------------------------------------- +-module(basic_bugs_hipe). + +-export([test/0]). + +test() -> + ok = test_ets_bifs(), + ok = test_szar_bug(), + ok = test_bit_shift(), + ok = test_match_big_list(), + ok = test_unsafe_bsl(), + ok = test_unsafe_bsr(), + ok = test_R12B5_seg_fault(), + ok = test_switch_neg_int(), + ok = test_icode_range_anal(), + ok. + +%%----------------------------------------------------------------------- +%% From: Bjorn Gustavsson +%% +%% This code, if HiPE compiled, crashed like this (on SPARC) +%% +%% (gdb) where +%% #0 fullsweep_heap (p=0x2c60dc, new_sz=610, objv=0xffbee8b4, nobj=3) +%% at beam/ggc.c:1060 +%% #1 0x7ff24 in erts_garbage_collect (p=0x2c60dc, need=2, objv=0x1128fc, ...) +%% at beam/ggc.c:1648 +%% #2 0xab6fc in hipe_mode_switch (p=0x2c60dc, cmd=704512, reg=0x1128fc) +%% at hipe/hipe_mode_switch.c:180 +%% #3 0x8e27c in process_main () at beam/beam_emu.c:3314 +%% #4 0x31338 in erl_start (argc=9, argv=0xffbeed5c) at beam/erl_init.c:936 +%% #5 0x2d9f4 in main (argc=9, argv=0xffbeed5c) at sys/unix/erl_main.c:28 +%% +%% A guess at what could be the problem: From R8, many ets BIFs trap +%% to other ets BIFs with a *different* arity (i.e. they have more or +%% less arguments). I have probably forgotten to mention that subtle +%% change. +%%----------------------------------------------------------------------- + +test_ets_bifs() -> + Seed = {1032, 15890, 22716}, + put(random_seed, Seed), + do_random_test(). + +do_random_test() -> + OrdSet = ets:new(xxx, [ordered_set]), + Set = ets:new(xxx, []), + do_n_times(fun() -> + Key = create_random_string(25), + Value = create_random_tuple(25), + ets:insert(OrdSet, {Key, Value}), + ets:insert(Set, {Key, Value}) + end, 5000), + %% io:format("~nData inserted~n"), + do_n_times(fun() -> + I = random:uniform(25), + Key = create_random_string(I) ++ '_', + L1 = ets_match_object(OrdSet, {Key, '_'}), + L2 = lists:sort(ets_match_object(Set, {Key, '_'})), + case L1 == L2 of + false -> + %% io:format("~p != ~p~n", [L1, L2]), + exit({not_eq, L1, L2}); + true -> + ok + end + end, 2000), + %% io:format("~nData matched~n"), + ets:match_delete(OrdSet, '_'), + ets:match_delete(Set, '_'), + ok. + +create_random_string(0) -> + []; +create_random_string(OfLength) -> + C = case random:uniform(2) of + 1 -> (random:uniform($Z - $A + 1) - 1) + $A; + _ -> (random:uniform($z - $a + 1) - 1) + $a + end, + [C | create_random_string(OfLength - 1)]. + +create_random_tuple(OfLength) -> + list_to_tuple([list_to_atom([X]) || X <- create_random_string(OfLength)]). + +ets_match_object(Tab,Expr) -> + case random:uniform(2) of + 1 -> ets:match_object(Tab,Expr); + _ -> match_object_chunked(Tab,Expr) + end. + +match_object_chunked(Tab,Expr) -> + match_object_chunked_collect(ets:match_object(Tab, Expr, + random:uniform(1999) + 1)). + +match_object_chunked_collect('$end_of_table') -> + []; +match_object_chunked_collect({Results, Continuation}) -> + Results ++ match_object_chunked_collect(ets:match_object(Continuation)). + +do_n_times(_, 0) -> + ok; +do_n_times(Fun, N) -> + Fun(), + case N rem 1000 of + 0 -> ok; %% WAS: io:format("."); + _ -> ok + end, + do_n_times(Fun, N - 1). + +%%----------------------------------------------------------------------- +%% From: Jozsef Berces (PR/ECZ) +%% Date: Feb 19, 2004 +%% +%% Program which was added to the testsuite as a result of another bug +%% report involving tuples as funs. Thanks God, these are no longer +%% supported, but the following is a good test for testing calling +%% native code funs from BEAM code (lists:map, lists:filter, ...). +%%----------------------------------------------------------------------- + +test_szar_bug() -> + ["A","B","C"] = smartconcat([], "H'A, H'B, H'C"), + ok. + +smartconcat(B, L) -> + LL = tokenize(L, $,), + NewlineDel = fun (X) -> killcontrol(X) end, + StripFun = fun (X) -> string:strip(X) end, + LL2 = lists:map(NewlineDel, lists:map(StripFun, LL)), + EmptyDel = fun(X) -> + case string:len(X) of + 0 -> false; + _ -> true + end + end, + LL3 = lists:filter(EmptyDel, LL2), + HexFormat = fun(X, Acc) -> + case string:str(X, "H'") of + 1 -> + case checkhex(string:substr(X, 3)) of + {ok, Y} -> + {Y, Acc}; + _ -> + {X, Acc + 1} + end; + _ -> + {X, Acc + 1} + end + end, + {LL4,_Ret} = lists:mapfoldl(HexFormat, 0, LL3), + lists:append(B, lists:sublist(LL4, lists:max([0, 25 - length(B)]))). + +checkhex(L) -> + checkhex(L, ""). + +checkhex([H | T], N) when H >= $0, H =< $9 -> + checkhex(T, [H | N]); +checkhex([H | T], N) when H >= $A, H =< $F -> + checkhex(T, [H | N]); +checkhex([H | T], N) when H =< 32 -> + checkhex(T, N); +checkhex([_ | _], _) -> + {error, ""}; +checkhex([], N) -> + {ok, lists:reverse(N)}. + +killcontrol([C | S]) when C < 32 -> + killcontrol(S); +killcontrol([C | S]) -> + [C | killcontrol(S)]; +killcontrol([]) -> + []. + +tokenize(L, C) -> + tokenize(L, C, [], []). + +tokenize([C | T], C, A, B) -> + case A of + [] -> + tokenize(T, C, [], B); + _ -> + tokenize(T, C, [], [lists:reverse(A) | B]) + end; +tokenize([H | T], C, A, B) -> + tokenize(T, C, [H | A], B); +tokenize(_, _, [], B) -> + lists:reverse(B); +tokenize(_, _, A, B) -> + lists:reverse([lists:reverse(A) | B]). + +%%----------------------------------------------------------------------- +%% From: Niclas Pehrsson +%% Date: Apr 20, 2006 +%% +%% We found something weird with the bit shifting in HiPE. It seems +%% that bsr in some cases shifts the bits in the wrong way... +%% +%% Fixed about 10 mins afterwards; was a bug in constant propagation. +%%----------------------------------------------------------------------- + +test_bit_shift() -> + 1 = plain_shift(), % 1 + 6 = length_list_plus(), % 6 + 0 = shift_length_list(), % 0 + 1 = shift_length_list_plus(), % 1 + 1 = shift_length_list_plus2(), % 1 + 24 = shift_length_list_plus_bsl(), % 24 + 1 = shift_fun(), % 1 + %% {1, 6, 0, 1, 1, 24, 1} = {A, B, C, D, E, F, G}, + ok. + +plain_shift() -> + 6 bsr 2. + +length_list() -> + length([0,0]). + +length_list_plus() -> + length([0,0]) + 4. + +shift_length_list() -> + length([0,0]) bsr 2. + +shift_length_list_plus() -> + (length([0,0]) + 4) bsr 2. + +shift_length_list_plus_bsl() -> + (length([0,0]) + 4) bsl 2. + +shift_length_list_plus2() -> + N = length([0,0]) + 4, + N bsr 2. + +shift_fun() -> + (length_list() + 4) bsr 2. + +%%----------------------------------------------------------------------- +%% From: Igor Goryachev +%% Date: June 15, 2006 +%% +%% I have experienced a different behaviour and possibly a weird result +%% while playing with matching a big list on x86 and x86_64 machines. +%%----------------------------------------------------------------------- + +-define(BIG_LIST, + ["uid", "nickname", "n_family", "n_given", "email_pref", + "tel_home_number", "tel_cellular_number", "adr_home_country", + "adr_home_locality", "adr_home_region", "url", "gender", "bday", + "constitution", "height", "weight", "hair", "routine", "smoke", + "maritalstatus", "children", "independence", "school_number", + "school_locality", "school_title", "school_period", "org_orgname", + "title", "adr_work_locality", "photo_type", "photo_binval"]). + +test_match_big_list() -> + case create_tuple_with_big_const_list() of + {selected, ?BIG_LIST, _} -> ok; + _ -> weird + end. + +create_tuple_with_big_const_list() -> + {selected, ?BIG_LIST, [{"test"}]}. + +%%----------------------------------------------------------------------- +%% In October 2006 the HiPE compiler acquired more type-driven +%% optimisations of arithmetic operations. One of these, the +%% transformation of bsl to a pure fixnum bsl fixnum -> fixnum version +%% (unsafe_bsl), was incorrectly performed even when the result +%% wouldn't be a fixnum. The error occurred for all backends, but the +%% only place known to break was hipe_arm:imm_to_am1/2. Some +%% immediates got broken on ARM, causing segmentation faults in +%% compiler_tests when HiPE recompiled itself. +%%----------------------------------------------------------------------- + +test_unsafe_bsl() -> + ok = bsl_check(bsl_test_cases()). + +bsl_test_cases() -> + [{16#FF, {16#FF, 0}}, + {16#F000000F, {16#FF, 2}}]. + +bsl_check([]) -> ok; +bsl_check([{X, Y}|Rest]) -> + case imm_to_am1(X) of + Y -> bsl_check(Rest); + _ -> 'hipe_broke_bsl' + end. + +imm_to_am1(Imm) -> + imm_to_am1(Imm band 16#FFFFFFFF, 16). +imm_to_am1(Imm, RotCnt) -> + if Imm >= 0, Imm =< 255 -> {Imm, RotCnt band 15}; + true -> + NewRotCnt = RotCnt - 1, + if NewRotCnt =:= 0 -> []; % full circle, no joy + true -> + NewImm = (Imm bsr 2) bor ((Imm band 3) bsl 30), + imm_to_am1(NewImm, NewRotCnt) + end + end. + +%%----------------------------------------------------------------------- +%% Another transformation, namely that of bsr to a pure fixnum bsr +%% fixnum -> fixnum version (unsafe_bsr), failed to check for shifts +%% larger than the number of bits in fixnums. Such shifts should +%% return zero, but instead they became plain machine-level shift +%% instructions. Machines often only consider the low-order bits of +%% the shift count, so machine-level shifts larger than the word size +%% do not match the Erlang semantics. +%%----------------------------------------------------------------------- + +test_unsafe_bsr() -> + ok = bsr_check(bsr_test_cases()). + +bsr_test_cases() -> + [{16#FF, 4, 16#0F}, + {16#FF, 64, 0}]. + +bsr_check([]) -> ok; +bsr_check([{X, Y, Z}|Rest]) -> + case do_bsr(X, Y) of + Z -> bsr_check(Rest); + _ -> 'hipe_broke_bsr' + end. + +do_bsr(X, Y) -> + (X band 16#FFFF) bsr (Y band 16#FFFF). + +%%----------------------------------------------------------------------- +%% From: Sergey S, mid January 2009. +%% +%% While I was playing with +native option, I run into a bug in HiPE +%% which leads to segmentation fault using +native and Erlang R12B-5. +%% +%% Eshell V5.6.5 +%% 1> crash:test(). +%% # Some message to be printed here each loop iteration +%% Segmentation fault +%% +%% Diagnosed and fixed by Mikael Pettersson (22 Jan 2009): +%% +%% I've analysed the recently posted HiPE bug report on erlang-bugs +%% <http://www.erlang.org/pipermail/erlang-bugs/2009-January/001162.html>. +%% The segfault is caused by memory corruption, which in turn is caused +%% by RTL removing an update of the HP (heap pointer) register due to +%% what looks like broken liveness information. +%%----------------------------------------------------------------------- + +test_R12B5_seg_fault() -> + _ = spawn(fun() -> init() end), + ok. + +init() -> + repeat(5, fun() -> void end), + receive after infinity -> ok end. + +repeat(0, _) -> + ok; +repeat(N, Fun) -> + %% io:format("# Some message to be printed here each loop iteration\n"), + Fun(), + repeat(N - 1, Fun). + +%%----------------------------------------------------------------------- +%% From: Jon Meredith +%% Date: July 9, 2009 +%% +%% Binary search key tables are sorted by the loader based on the +%% runtime representations of the keys as unsigned words. However, +%% the code generated for the binary search used signed comparisons. +%% That worked for atoms and non-negative fixnums, but not for +%% negative fixnums. Fixed by Mikael Pettersson July 10, 2009. +%%----------------------------------------------------------------------- + +test_switch_neg_int() -> + ok = f(-80, 8). + +f(10, -1) -> ok; +f(X, Y) -> + Y = g(X), + f(X + 10, Y - 1). + +g(X) -> % g(0) should be 0 but became -1 + case X of + 0 -> 0; + -10 -> 1; + -20 -> 2; + -30 -> 3; + -40 -> 4; + -50 -> 5; + -60 -> 6; + -70 -> 7; + -80 -> 8; + _ -> -1 + end. + +%%----------------------------------------------------------------------- +%% From: Paul Guyot +%% Date: Jan 31, 2011 +%% +%% There is a bug in HiPE compilation with the comparison of floats +%% with integers. This bug happens in functions f/1 and g/2 below. +%% BEAM will evaluate f_eq(42) and f_eq(42.0) to true, while HiPE +%% will evaluate them to false. +%% +%% The culprit was the Icode range analysis which was buggy. (On the +%% other hand, HiPE properly evaluated these calls to true if passed +%% the option 'no_icode_range'.) Fixed by Kostis Sagonas. +%% -------------------------------------------------------------------- + +test_icode_range_anal() -> + true = f_eq(42), + true = f_eq(42.0), + false = f_ne(42), + false = f_ne(42.0), + false = f_eq_ex(42), + false = f_eq_ex(42.0), + true = f_ne_ex(42), + true = f_ne_ex(42.0), + false = f_gt(42), + false = f_gt(42.0), + true = f_le(42), + true = f_le(42.0), + zero_test = g(0, test), + zero_test = g(0.0, test), + non_zero_test = g(42, test), + other = g(42, other), + ok. + +f_eq(X) -> + Y = X / 2, + Y == 21. + +f_ne(X) -> + Y = X / 2, + Y /= 21. + +f_eq_ex(X) -> + Y = X / 2, + Y =:= 21. + +f_ne_ex(X) -> + Y = X / 2, + Y =/= 21. + +f_gt(X) -> + Y = X / 2, + Y > 21. + +f_le(X) -> + Y = X / 2, + Y =< 21. + +g(X, Z) -> + Y = X / 2, + case Z of + test when Y == 0 -> zero_test; + test -> non_zero_test; + other -> other + end. diff --git a/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl b/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl new file mode 100644 index 0000000000..8dab2cab1f --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl @@ -0,0 +1,157 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for correct execution of comparison operators. +%%%------------------------------------------------------------------- +-module(basic_comparisons). + +-export([test/0]). + +test() -> + Ns = [0, 0.0, 42, 42.0, gazonk], + T1F4 = [true, false, false, false, false], + T2F3 = [true, true, false, false, false], + F1T4 = [false, true, true, true, true], + F2T3 = [false, false, true, true, true], + %% tests for calls + T1F4 = [eq_exact_call(0, N) || N <- Ns], + F1T4 = [ne_exact_call(0, N) || N <- Ns], + T2F3 = [eq_call(0, N) || N <- Ns], + F2T3 = [ne_call(0, N) || N <- Ns], + %% tests for guards + T1F4 = [eq_exact_guard(0, N) || N <- Ns], + F1T4 = [ne_exact_guard(0, N) || N <- Ns], + T2F3 = [eq_guard(0, N) || N <- Ns], + F2T3 = [ne_guard(0, N) || N <- Ns], + %% some more tests + ok = test_against_zero(), + ok = test_against_other_terms(), + ok = test_sofs_func(), + ok. + +test_against_zero() -> + Xs = [0, 1, 0.0], + [true, false, false] = [is_zero_int(X) || X <- Xs], + [true, false, true] = [is_zero_num(X) || X <- Xs], + [false, true, true] = [is_nonzero_int(X) || X <- Xs], + [false, true, false] = [is_nonzero_num(X) || X <- Xs], + ok. + +test_against_other_terms() -> + TTT = {true, true, true}, + FFF = {false, false, false}, + TTT = {is_foo_exact(foo), is_foo_term1(foo), is_foo_term2(foo)}, + FFF = {is_foo_exact(bar), is_foo_term1(bar), is_foo_term2(bar)}, + FFF = {is_nonfoo_exact(foo), is_nonfoo_term1(foo), is_nonfoo_term2(foo)}, + TTT = {is_nonfoo_exact(bar), is_nonfoo_term1(bar), is_nonfoo_term2(bar)}, + Tup = {a, {42}, [c]}, + TTT = {is_tuple_skel(Tup), is_tuple_exact(Tup), is_tuple_term(Tup)}, + BNi = <<42>>, + TTT = {is_bin_exact(BNi), is_bin_term1(BNi), is_bin_term2(BNi)}, + BNf = <<42/float>>, + FFF = {is_bin_exact(BNf), is_bin_term1(BNf), is_bin_term2(BNf)}, + ok. + +test_sofs_func() -> + L = [0, 0.0], + ok = sofs_func(L, L, L). + +%%-------------------------------------------------------------------- +%% Test for comparison operators used in body calls + +eq_exact_call(X, Y) -> X =:= Y. + +ne_exact_call(X, Y) -> X =/= Y. + +eq_call(X, Y) -> X == Y. + +ne_call(X, Y) -> X /= Y. + +%%-------------------------------------------------------------------- +%% Tests for comparison operators used as guards + +eq_exact_guard(X, Y) when X =:= Y -> true; +eq_exact_guard(_, _) -> false. + +ne_exact_guard(X, Y) when X =/= Y -> true; +ne_exact_guard(_, _) -> false. + +eq_guard(X, Y) when X == Y -> true; +eq_guard(_, _) -> false. + +ne_guard(X, Y) when X /= Y -> true; +ne_guard(_, _) -> false. + +%%-------------------------------------------------------------------- + +is_zero_int(N) when N =:= 0 -> true; +is_zero_int(_) -> false. + +is_nonzero_int(N) when N =/= 0 -> true; +is_nonzero_int(_) -> false. + +is_zero_num(N) when N == 0 -> true; +is_zero_num(_) -> false. + +is_nonzero_num(N) when N /= 0 -> true; +is_nonzero_num(_) -> false. + +%%-------------------------------------------------------------------- +%% There should not really be any difference in the generated code +%% for the following three functions. + +is_foo_exact(A) when A =:= foo -> true; +is_foo_exact(_) -> false. + +is_foo_term1(A) when A == foo -> true; +is_foo_term1(_) -> false. + +is_foo_term2(A) when foo == A -> true; +is_foo_term2(_) -> false. + +%%-------------------------------------------------------------------- +%% Same for these cases + +is_nonfoo_exact(A) when A =/= foo -> true; +is_nonfoo_exact(_) -> false. + +is_nonfoo_term1(A) when A /= foo -> true; +is_nonfoo_term1(_) -> false. + +is_nonfoo_term2(A) when foo /= A -> true; +is_nonfoo_term2(_) -> false. + +%%-------------------------------------------------------------------- + +is_tuple_skel({A,{B},[C]}) when is_atom(A), is_integer(B), is_atom(C) -> true; +is_tuple_skel(T) when is_tuple(T) -> false. + +is_tuple_exact(T) when T =:= {a,{42},[c]} -> true; +is_tuple_exact(T) when is_tuple(T) -> false. + +is_tuple_term(T) when T == {a,{42.0},[c]} -> true; +is_tuple_term(T) when is_tuple(T) -> false. + +%%-------------------------------------------------------------------- +%% But for binaries the treatment has to be different, due to the need +%% for construction of the binary in the guard. + +is_bin_exact(B) when B =:= <<42>> -> true; +is_bin_exact(_) -> false. + +is_bin_term1(B) when B == <<42>> -> true; +is_bin_term1(_) -> false. + +is_bin_term2(B) when <<42>> == B -> true; +is_bin_term2(_) -> false. + +%%-------------------------------------------------------------------- +%% a test from sofs.erl which failed at some point + +sofs_func([X | Ts], X0, L) when X /= X0 -> + sofs_func(Ts, X, L); +sofs_func([X | _Ts], X0, _L) when X == X0 -> + ok; +sofs_func([], _X0, L) -> + L. diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl new file mode 100644 index 0000000000..229a0516dc --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl @@ -0,0 +1,465 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that raise exceptions and catch them. +%%%------------------------------------------------------------------- +-module(basic_exceptions). + +-export([test/0, test_catches/0]). + +%% functions used as arguments to spawn/3 +-export([bad_guy/2]). + +test() -> + ok = test_catch_exit(42), + ok = test_catch_throw(42), + ok = test_catch_element(), + ok = test_catch_crash(), + ok = test_catch_empty(), + ok = test_catch_merge(), + ok = test_catches_merged(), + ok = test_pending_errors(), + ok = test_bad_fun_call(), + ok = test_guard_bif(), + ok. + +%%-------------------------------------------------------------------- +%% Written in 2001 by Erik Johansson. + +test_catches() -> + ExitBar = {'EXIT', bar}, + L1 = [ExitBar, ok, ExitBar, {ok, ExitBar}], + L1 = [t1(), t2(), t3(), t4()], + badarith = (catch element(1, element(2, t5(a, b)))), + L2 = [42, ExitBar, ExitBar, {no_exception, ok}], + L2 = [t5(21, 21), t6(), t7(), t8()], + ok. + +t1() -> + catch foo(). + +t2() -> + V = (catch ok()), + s(), + V. + +t3() -> + V = (catch foo()), + V. + +t4() -> + V1 = ok(), + V2 = (catch foo()), + {V1, V2}. + +t5(A, B) -> + catch A + B. + +t6() -> + catch {no_exception, ok(), foo()}. + +t7() -> + catch {no_exception, foo(), ok()}. + +t8() -> + catch {no_exception, ok()}. + +foo() -> + s(), + exit(bar). + +ok() -> s(), ok. + +s() -> nada. + +%%-------------------------------------------------------------------- + +test_catch_exit(N) -> + {'EXIT', N} = (catch exit(N)), + {'EXIT', 42} = (catch exit(42)), + 42 = try exit(N) catch exit:R1 -> R1 end, + 42 = try exit(42) catch exit:R2 -> R2 end, + ok. + +%%-------------------------------------------------------------------- + +test_catch_throw(N) -> + N = (catch throw(N)), + 42 = (catch throw(42)), + 42 = try throw(N) catch throw:R1 -> R1 end, + 42 = try throw(42) catch throw:R2 -> R2 end, + ok. + +%%-------------------------------------------------------------------- + +test_catch_element() -> + 'EXIT' = test_catch_element([]), + 'EXIT' = test_catch_element(42), + ok. + +test_catch_element(N) -> + element(1, catch element(N, {1,2,3,4,5,6,7,8,9,10,11})). + +%%-------------------------------------------------------------------- + +-define(try_match(E), + catch ?MODULE:non_existing(), + {'EXIT', {{badmatch, nomatch}, _}} = (catch E = no_match())). + +test_catch_crash() -> + ?try_match(a), + ?try_match(42), + ?try_match({a, b, c}), + ?try_match([]), + ?try_match(1.0), + ok. + +no_match() -> nomatch. + +%% small_test() -> +%% catch ?MODULE:non_existing(), +%% io:format("Before\n",[]), +%% hipe_bifs:show_nstack(self()), +%% io:format("After\n",[]), +%% garbage_collect(). + +%%-------------------------------------------------------------------- +%% Tests whether the HiPE compiler optimizes catches in a way that +%% does not result in an infinite loop. +%%-------------------------------------------------------------------- + +test_catch_empty() -> + badmatch(). + +badmatch() -> + Big = ret_big(), + Float = ret_float(), + catch a = Big, + catch b = Float, + ok = case Big of Big -> ok end, + ok = case Float of Float -> ok end, + ok. + +ret_big() -> + 329847987298478924982978248748729829487298292982972978239874. + +ret_float() -> + 3.1415927. + +%%-------------------------------------------------------------------- +%% Test that shows how BEAM can merge catch-end blocks that belong to +%% different catch-start instructions. Written by Richard Carlsson. +%%-------------------------------------------------------------------- + +test_catch_merge() -> + merge(get(whatever)). + +merge(foo=X) -> + catch f(X), + catch g(X); +merge(X) -> + catch f(X), + catch g(X). + +f(_) -> ok. + +g(_) -> ok. + +%%-------------------------------------------------------------------- +%% Written by Tobias Lindahl. + +test_catches_merged() -> + {'EXIT', _} = merged_catches(foo), + {'EXIT', {badarith, _}} = merged_catches(bar), + {'EXIT', _} = merged_catches(baz), + ok. + +merged_catches(X) -> + case X of + foo -> catch fail1(0); + bar -> catch {catch(1 = X), fail2(0)}; + baz -> catch fail3(0) + end. + +fail1(X) -> 1/X. + +fail2(X) -> 1/X. + +fail3(X) -> 1/X. + +%%-------------------------------------------------------------------- +%% Taken from exception_SUITE.erl +%%-------------------------------------------------------------------- + +test_pending_errors() -> + error_logger:tty(false), % disable printouts of error reports + pending_errors(). + +%% Test various exceptions, in the presence of a previous error +%% suppressed in a guard. +pending_errors() -> + pending(e_badmatch, {badmatch, b}), + pending(x, function_clause), + pending(e_case, {case_clause, xxx}), + pending(e_if, if_clause), + %% pending(e_badarith, badarith), + %% pending(e_undef, undef), + pending(e_timeoutval, timeout_value), + %% pending(e_badarg, badarg), + %% pending(e_badarg_spawn, badarg), + ok. + +bad_guy(pe_badarith, Other) when Other+1 =:= 0 -> % badarith (suppressed) + ok; +bad_guy(pe_badarg, Other) when length(Other) > 0 -> % badarg (suppressed) + ok; +bad_guy(_, e_case) -> + case xxx() of + ok -> ok + end; % case_clause +bad_guy(_, e_if) -> + B = b(), + if + a == B -> ok + end; % if_clause +%% bad_guy(_, e_badarith) -> +%% 1+b; % badarith +bad_guy(_, e_undef) -> + non_existing_module:foo(); % undef +bad_guy(_, e_timeoutval) -> + receive + after gazonk -> ok % timeout_value + end; +bad_guy(_, e_badarg) -> + node(xxx); % badarg +bad_guy(_, e_badarg_spawn) -> + spawn({}, {}, {}); % badarg +bad_guy(_, e_badmatch) -> + a = b(). % badmatch + +xxx() -> xxx. + +b() -> b. + +pending(Arg, Expected) -> + pending(pe_badarith, Arg, Expected), + pending(pe_badarg, Arg, Expected). + +pending(First, Second, Expected) -> + pending_catched(First, Second, Expected), + pending_exit_message([First, Second], Expected). + +pending_catched(First, Second, Expected) -> + %% ok = io:format("Catching bad_guy(~p, ~p)\n", [First, Second]), + case catch bad_guy(First, Second) of + {'EXIT', Reason} -> + pending(Reason, bad_guy, [First, Second], Expected); + Other -> + exit({not_exit, Other}) + end. + +pending_exit_message(Args, Expected) -> + %% ok = io:format("Trapping exits from spawn_link(~p, ~p, ~p)\n", + %% [?MODULE, bad_guy, Args]), + process_flag(trap_exit, true), + Pid = spawn_link(?MODULE, bad_guy, Args), + receive + {'EXIT', Pid, Reason} -> + pending(Reason, bad_guy, Args, Expected); + Other -> + exit({unexpected_message, Other}) + after 10000 -> + exit(timeout) + end, + process_flag(trap_exit, false). + +%% pending({badarg, [{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]}, +%% Func, Args, _Code) +%% when atom(Bif), list(BifArgs), length(Args) =:= Arity -> +%% ok; +pending({badarg,Trace}, _, _, _) when is_list(Trace) -> + ok; +%% pending({undef,[{non_existing_module,foo,[]}|_]}, _, _, _) -> +%% ok; +pending({undef,Trace}, _, _, _) when is_list(Trace) -> + ok; +%% pending({function_clause,[{?MODULE,Func,Args}|_]}, Func, Args, _Code) -> +%% ok; +pending({function_clause,Trace}, _, _, _) when is_list(Trace) -> + ok; +%% pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code) +%% when length(Args) =:= Arity -> +%% ok; +pending({Code,Trace}, _, _, Code) when is_list(Trace) -> + ok; +pending(Reason, _Function, _Args, _Code) -> + exit({bad_exit_reason, Reason}). + +%%-------------------------------------------------------------------- +%% Taken from fun_SUITE.erl +%% +%% Checks correct exception throwing when calling a bad fun. +%%-------------------------------------------------------------------- + +test_bad_fun_call() -> + ok = bad_call_fc(42), + ok = bad_call_fc(xx), + ok = bad_call_fc({}), + ok = bad_call_fc({1}), + ok = bad_call_fc({1,2,3}), + ok = bad_call_fc({1,2,3}), + ok = bad_call_fc({1,2,3,4}), + ok = bad_call_fc({1,2,3,4,5,6}), + ok = bad_call_fc({1,2,3,4,5}), + ok = bad_call_fc({1,2}), + ok. + +bad_call_fc(Fun) -> + Args = [some, stupid, args], + Res = (catch Fun(Fun(Args))), + case Res of + {'EXIT', {{badfun, Fun} ,_Where}} -> + ok; %% = io:format("~p(~p) -> ~p\n", [Fun, Args, Res]); + Other -> + io:format("~p(~p) -> ~p\n", [Fun, Args, Res]), + exit({bad_result, Other}) + end. + +%%-------------------------------------------------------------------- +%% Taken from guard_SUITE.erl +%% +%% Tests correct handling of exceptions by calling guard BIFs with +%% nasty (but legal arguments). +%%-------------------------------------------------------------------- + +test_guard_bif() -> + Big = -237849247829874297658726487367328971246284736473821617265433, + Float = 387924.874, + + %% Succeding use of guard bifs. + + try_gbif('abs/1', Big, -Big), + try_gbif('float/1', Big, float(Big)), + try_gbif('trunc/1', Float, 387924.0), + try_gbif('round/1', Float, 387925.0), + try_gbif('length/1', [], 0), + + try_gbif('length/1', [a], 1), + try_gbif('length/1', [a, b], 2), + try_gbif('length/1', lists:seq(0, 31), 32), + + try_gbif('hd/1', [a], a), + try_gbif('hd/1', [a, b], a), + + try_gbif('tl/1', [a], []), + try_gbif('tl/1', [a, b], [b]), + try_gbif('tl/1', [a, b, c], [b, c]), + + try_gbif('size/1', {}, 0), + try_gbif('size/1', {a}, 1), + try_gbif('size/1', {a, b}, 2), + try_gbif('size/1', {a, b, c}, 3), + try_gbif('size/1', list_to_binary([]), 0), + try_gbif('size/1', list_to_binary([1]), 1), + try_gbif('size/1', list_to_binary([1, 2]), 2), + try_gbif('size/1', list_to_binary([1, 2, 3]), 3), + + try_gbif('element/2', {x}, {1, x}), + try_gbif('element/2', {x, y}, {1, x}), + try_gbif('element/2', {x, y}, {2, y}), + + try_gbif('self/0', 0, self()), + try_gbif('node/0', 0, node()), + try_gbif('node/1', self(), node()), + + %% Failing use of guard bifs. + + try_fail_gbif('abs/1', Big, 1), + try_fail_gbif('abs/1', [], 1), + + try_fail_gbif('float/1', Big, 42), + try_fail_gbif('float/1', [], 42), + + try_fail_gbif('trunc/1', Float, 0.0), + try_fail_gbif('trunc/1', [], 0.0), + + try_fail_gbif('round/1', Float, 1.0), + try_fail_gbif('round/1', [], a), + + try_fail_gbif('length/1', [], 1), + try_fail_gbif('length/1', [a], 0), + try_fail_gbif('length/1', a, 0), + try_fail_gbif('length/1', {a}, 0), + + try_fail_gbif('hd/1', [], 0), + try_fail_gbif('hd/1', [a], x), + try_fail_gbif('hd/1', x, x), + + try_fail_gbif('tl/1', [], 0), + try_fail_gbif('tl/1', [a], x), + try_fail_gbif('tl/1', x, x), + + try_fail_gbif('size/1', {}, 1), + try_fail_gbif('size/1', [], 0), + try_fail_gbif('size/1', [a], 1), + try_fail_gbif('size/1', fun() -> 1 end, 0), + try_fail_gbif('size/1', fun() -> 1 end, 1), + + try_fail_gbif('element/2', {}, {1, x}), + try_fail_gbif('element/2', {x}, {1, y}), + try_fail_gbif('element/2', [], {1, z}), + + try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")), + try_fail_gbif('node/0', 0, xxxx), + try_fail_gbif('node/1', self(), xxx), + try_fail_gbif('node/1', yyy, xxx), + ok. + +try_gbif(Id, X, Y) -> + case guard_bif(Id, X, Y) of + {Id, X, Y} -> + %% io:format("guard_bif(~p, ~p, ~p) -- ok\n", [Id, X, Y]); + ok; + Other -> + ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + exit({bad_result,try_gbif}) + end. + +try_fail_gbif(Id, X, Y) -> + case catch guard_bif(Id, X, Y) of + %% {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} -> + {'EXIT', {function_clause,_}} -> % in HiPE, a trace is not generated + %% io:format("guard_bif(~p, ~p, ~p) -- ok\n", [Id,X,Y]); + ok; + Other -> + ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + exit({bad_result,try_fail_gbif}) + end. + +guard_bif('abs/1', X, Y) when abs(X) == Y -> + {'abs/1', X, Y}; +guard_bif('float/1', X, Y) when float(X) == Y -> + {'float/1', X, Y}; +guard_bif('trunc/1', X, Y) when trunc(X) == Y -> + {'trunc/1', X, Y}; +guard_bif('round/1', X, Y) when round(X) == Y -> + {'round/1', X, Y}; +guard_bif('length/1', X, Y) when length(X) == Y -> + {'length/1', X, Y}; +guard_bif('hd/1', X, Y) when hd(X) == Y -> + {'hd/1', X, Y}; +guard_bif('tl/1', X, Y) when tl(X) == Y -> + {'tl/1', X, Y}; +guard_bif('size/1', X, Y) when size(X) == Y -> + {'size/1', X, Y}; +guard_bif('element/2', X, {Pos, Expected}) when element(Pos, X) == Expected -> + {'element/2', X, {Pos, Expected}}; +guard_bif('self/0', X, Y) when self() == Y -> + {'self/0', X, Y}; +guard_bif('node/0', X, Y) when node() == Y -> + {'node/0', X, Y}; +guard_bif('node/1', X, Y) when node(X) == Y -> + {'node/1', X, Y}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_floats.erl b/lib/hipe/test/basic_SUITE_data/basic_floats.erl new file mode 100644 index 0000000000..eec175075a --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_floats.erl @@ -0,0 +1,180 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate floating point numbers. +%%%------------------------------------------------------------------- +-module(basic_floats). + +-export([test/0]). +-export([test_fmt_double_fpe_leak/0]). % suppress the unused warning + +test() -> + ok = test_arith_ops(), + ok = test_fp_ebb(), + ok = test_fp_phi(), + ok = test_big_bad_float(), + ok = test_catch_bad_fp_arith(), + ok = test_catch_fp_conv(), + ok = test_fp_with_fp_exceptions(), + %% ok = test_fmt_double_fpe_leak(), % this requires printing + ok. + +%%-------------------------------------------------------------------- + +test_arith_ops() -> + E = 2.5617, + 5.703200000000001 = add(E), + 0.5798000000000001 = sub(E), + 8.047580550000001 = mult(E), + -6.023e23 = negate(6.023e23), + ok. + +add(X) -> + 3.1415 + X. + +sub(X) -> + 3.1415 - X. + +mult(X) -> + 3.1415 * X. + +%% tests the translation of the fnegate BEAM instruction. +negate(X) -> + - (X + 0.0). + +%%-------------------------------------------------------------------- +%% Test the construction of overlapping extended basic blocks where +%% BEAM has constructed one and hipe_icode_fp constructs the other. +%%-------------------------------------------------------------------- + +test_fp_ebb() -> + 1.0 = foo(2 * math:pi()), + 1.0 = bar(2 * math:pi()), + ok. + +foo(X) -> + X / (2 * math:pi()). + +bar(X) -> + F = float_two(), + case F < 3.0 of + true -> (X * F) / ((2 * F) * math:pi()); + false -> weird + end. + +float_two() -> + 2.0. + +%%-------------------------------------------------------------------- + +test_fp_phi() -> + 10 = fp_phi(10, 100), + undefined = fp_phi(1.1e302, 0.000000001), + ok. + +fp_phi(A, B) -> + case catch A / B of + {'EXIT', _Reason} -> undefined; + _ -> round(100 * (A / B)) + end. + +%%-------------------------------------------------------------------- + +-define(BS, "93904329458954829589425849258998492384932849328493284932849328493284932389248329432932483294832949245827588578423578435783475834758375837580745807304258924584295924588459834958349589348589345934859384958349583945893458934859438593485995348594385943859438593458934589345938594385934859483958348934589435894859485943859438594594385938459438595034950439504395043950495043593485943758.0"). + +test_big_bad_float() -> + ok = try f2l(?BS) catch error:badarg -> ok end, + ok = case catch f2l(?BS) of {'EXIT', {badarg, _}} -> ok end, + ok. + +f2l(F) -> + float_to_list(list_to_float(F)). + +%%-------------------------------------------------------------------- +%% Tests catching of floating point bad arithmetic. + +test_catch_bad_fp_arith() -> + 5.7 = f(2.56), + {'EXIT', {badarith, _}} = bad_arith(9.9), + ok. + +f(F) when is_float(F) -> F + 3.14. + +bad_arith(F) when is_float(F) -> + catch F * 1.70000e+308. + +%%-------------------------------------------------------------------- +%% Tests proper catching of exceptions due to illegal convertion of +%% bignums to floating point numbers. + +test_catch_fp_conv() -> + F = 1.7e308, %% F is a number very close to a maximum float. + ok = big_arith(F), + ok = big_const_float(F), + ok. + +big_arith(F) -> + I = trunc(F), + {'EXIT', {badarith, _}} = big_int_arith(I), + ok. + +big_int_arith(I) when is_integer(I) -> + catch(3.0 + 2*I). + +big_const_float(F) -> + I = trunc(F), + badarith = try (1/(2*I)) catch error:Err -> Err end, + _ = 2/I, + {'EXIT', _} = (catch 4/(2*I)), + ok. + +%%-------------------------------------------------------------------- +%% Forces floating point exceptions and tests that subsequent, legal, +%% operations are calculated correctly. + +test_fp_with_fp_exceptions() -> + 0.0 = math:log(1.0), + badarith = try math:log(float_minus_one()) catch error:E1 -> E1 end, + 0.0 = math:log(1.0), + badarith = try math:log(float_zero()) catch error:E2 -> E2 end, + 0.0 = math:log(1.0), + %% An old-fashioned exception here just so as to test this case also + {'EXIT', _} = (catch fp_mult(3.23e133, 3.57e257)), + 0.0 = math:log(1.0), + badarith = try fp_div(5.0, 0.0) catch error:E3 -> E3 end, + 0.0 = math:log(1.0), + ok. + +fp_mult(X, Y) -> X * Y. + +fp_div(X, Y) -> X / Y. + +%% The following two function definitions appear here just to shut +%% off 'expression will fail with a badarg' warnings from the compiler + +float_zero() -> 0.0. + +float_minus_one() -> -1.0. + +%%-------------------------------------------------------------------- +%% Test that erl_printf_format.c:fmt_double() does not leak pending FP +%% exceptions to subsequent code. This used to break x87 FP code on +%% 32-bit x86. Based on a problem report from Richard Carlsson. + +test_fmt_double_fpe_leak() -> + test_fmt_double_fpe_leak(float_zero(), int_two()), + ok. + +%% We need the specific sequence of erlang:display/1 on a float that +%% triggers faulting ops in fmt_double() followed by a simple FP BIF. +%% We also need to repeat this at least three times. +test_fmt_double_fpe_leak(X, Y) -> + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), + math:log10(Y). + +int_two() -> 2. diff --git a/lib/hipe/test/basic_SUITE_data/basic_fun.erl b/lib/hipe/test/basic_SUITE_data/basic_fun.erl new file mode 100644 index 0000000000..18ba7fdb3f --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_fun.erl @@ -0,0 +1,124 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests for correct handling of funs. +%%%------------------------------------------------------------------- +-module(basic_fun). + +-export([test/0]). + +-export([dummy_foo/4, add1/1, test_fun03/0]). + +test() -> + ok = test_calls(), + ok = test_is_function(), + ok = test_is_function2(), + ok. + +%%-------------------------------------------------------------------- +%% Tests function and fun calls. + +test_calls() -> + ok = test_apply_call(?MODULE, dummy_foo), + ok = test_fun_call(fun dummy_foo/4), + ok = test_fun_call(fun ?MODULE:dummy_foo/4), + ok. + +test_apply_call(M, F) -> + M:F(bar, 42, foo, 17). + +test_fun_call(Fun) -> + Fun(bar, 42, foo, 17). + +dummy_foo(_, _, foo, _) -> ok. + +%%-------------------------------------------------------------------- +%% Tests handling of funs out of exported functions and 2-tuple funs. + +test_fun03() -> + MFPair = add1_as_2tuple(), + 4712 = do_call(add1_as_export(), 4711), + {badfun, MFPair} = try do_call(MFPair, 88) catch error:Err -> Err end, + true = do_guard(add1_as_export()), + false = do_guard(MFPair), % 2-tuples do not satisfy is_function/1 + ok. + +do_call(F, X) -> F(X). + +do_guard(F) when is_function(F) -> true; +do_guard(_) -> false. + +add1_as_export() -> fun ?MODULE:add1/1. + +add1_as_2tuple() -> {?MODULE, add1}. + +add1(X) -> X+1. + +%%-------------------------------------------------------------------- +%% Tests the is_function guard and BIF. + +test_is_function() -> + Fun = fun (X, foo) -> dummy_foo(X, mnesia_lib, foo, [X]) end, + ok = test_when_guard(Fun), + ok = test_if_guard(Fun), + ok. + +test_when_guard(X) when is_function(X) -> ok. + +test_if_guard(X) -> + if is_function(X) -> ok; + true -> weird + end. + +%%-------------------------------------------------------------------- +%% Tests the is_function2 guard and BIF. + +test_is_function2() -> + ok = test_guard(), + ok = test_guard2(), + ok = test_call(), + ok. + +test_guard() -> + zero_fun = test_f2(fun () -> ok end), + unary_fun = test_f2(fun(X) -> X end), + binary_fun = test_f2(fun (X, Y) -> {X, Y} end), + no_fun = test_f2(gazonk), + ok. + +test_f2(Fun) when is_function(Fun, 0) -> + zero_fun; +test_f2(Fun) when is_function(Fun, 1) -> + unary_fun; +test_f2(Fun) when is_function(Fun, 2) -> + binary_fun; +test_f2(_) -> + no_fun. + +test_guard2() -> + zero_fun = test_f2_n(fun () -> ok end, 0), + unary_fun = test_f2_n(fun (X) -> X end, 1), + binary_fun = test_f2_n(fun (X, Y) -> {X, Y} end, 2), + no_fun = test_f2_n(gazonk, 0), + ok. + +test_f2_n(F, N) when is_function(F, N) -> + case N of + 0 -> zero_fun; + 1 -> unary_fun; + 2 -> binary_fun + end; +test_f2_n(_, _) -> + no_fun. + +test_call() -> + true = test_fn2(fun (X, Y) -> {X,Y} end, 2), + false = test_fn2(fun (X, Y) -> {X,Y} end, 3), + false = test_fn2(gazonk, 2), + {'EXIT', {badarg, _TR1}} = (catch test_fn2(gazonk, gazonk)), + {'EXIT', {badarg, _TR2}} = (catch test_fn2(fun (X, Y) -> {X, Y} end, gazonk)), + ok. + +test_fn2(F, N) -> + is_function(F, N). diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl new file mode 100644 index 0000000000..81eeed7c3b --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl @@ -0,0 +1,164 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for correct handling of guards and guard BIFs. +%%%------------------------------------------------------------------- +-module(basic_guards). + +-export([test/0]). +%% Prevent the inlining of the following functions +-export([bad_arith/0, bad_tuple/0, is_strange_guard/0]). + +test() -> + ok = guard0(4.2), + ok = guard1([foo]), + ok = test_guard2(), + ok = test_guard3(), + ok = test_guard4(), + ok = test_is_boolean(), + ok = test_bad_guards(), + ok. + +%%-------------------------------------------------------------------- + +guard0(X) when X /= 0, is_float(X) -> + ok. + +guard1(X) when is_atom(X) orelse is_float(X) -> + error1; +guard1(X) when is_reference(hd(X)) -> + error2; +guard1(X) when is_integer(hd(X)) -> + error3; +guard1(X) when hd(X) == foo -> + ok. + +%%-------------------------------------------------------------------- + +test_guard2() -> + ok1 = guard2(true), + not_boolean = guard2(42), + ok2 = guard2(false), + ok. + +guard2(X) when X -> % gets transformed to: is_boolean(X), X =:= true + ok1; +guard2(X) when X =:= false -> + ok2; +guard2(_) -> + not_boolean. + +%%-------------------------------------------------------------------- + +-define(is_foo(X), (is_atom(X) or (is_tuple(X) and (element(1, X) =:= 'foo')))). + +test_guard3() -> + no = f('foo'), + yes = f({'foo', 42}), + no = f(42), + ok. + +f(X) when ?is_foo(X) -> yes; +f(_) -> no. + +%%-------------------------------------------------------------------- + +-define(EXT_REF, <<131,114,0,3,100,0,19,114,101,102,95,116,101,115,116,95,98,117,103,64,103,111,114,98,97,103,2,0,0,0,125,0,0,0,0,0,0,0,0>>). + +test_guard4() -> + yes = is_ref(make_ref()), + no = is_ref(gazonk), + yes = is_ref(an_external_ref(?EXT_REF)), + ok. + +is_ref(Ref) when is_reference(Ref) -> yes; +is_ref(_Ref) -> no. + +an_external_ref(Bin) -> + binary_to_term(Bin). + +%%-------------------------------------------------------------------- + +test_is_boolean() -> + ok = is_boolean_in_if(), + ok = is_boolean_in_guard(). + +is_boolean_in_if() -> + ok1 = tif(true), + ok2 = tif(false), + not_bool = tif(other), + ok. + +is_boolean_in_guard() -> + ok = tg(true), + ok = tg(false), + not_bool = tg(other), + ok. + +tif(V) -> + Yes = yes(), %% just to prevent the optimizer removing this + if + %% the following line generates an is_boolean instruction + V, Yes == yes -> + %% while the following one does not (?!) + %% Yes == yes, V -> + ok1; + not(not(not(V))) -> + ok2; + V -> + ok3; + true -> + not_bool + end. + +tg(V) when is_boolean(V) -> + ok; +tg(_) -> + not_bool. + +yes() -> yes. + +%%-------------------------------------------------------------------- +%% original test by Bjorn G + +test_bad_guards() -> + ok = bad_arith(), + ok = bad_tuple(), + ok = is_strange_guard(), + ok. + +bad_arith() -> + 13 = bad_arith1(1, 12), + 42 = bad_arith1(1, infinity), + 42 = bad_arith1(infinity, 1), + 42 = bad_arith2(infinity, 1), + 42 = bad_arith3(inf), + 42 = bad_arith4(infinity, 1), + ok. + +bad_arith1(T1, T2) when (T1 + T2) < 17 -> T1 + T2; +bad_arith1(_, _) -> 42. + +bad_arith2(T1, T2) when (T1 * T2) < 17 -> T1 * T2; +bad_arith2(_, _) -> 42. + +bad_arith3(T) when (bnot T) < 17 -> T; +bad_arith3(_) -> 42. + +bad_arith4(T1, T2) when (T1 bsr T2) < 10 -> T1 bsr T2; +bad_arith4(_, _) -> 42. + +bad_tuple() -> + error = bad_tuple1(a), + error = bad_tuple1({a, b}), + x = bad_tuple1({x, b}), + y = bad_tuple1({a, b, y}), + ok. + +bad_tuple1(T) when element(1, T) =:= x -> x; +bad_tuple1(T) when element(3, T) =:= y -> y; +bad_tuple1(_) -> error. + +is_strange_guard() when is_tuple({1, bar, length([1, 2, 3, 4]), self()}) -> ok; +is_strange_guard() -> error. diff --git a/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl b/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl new file mode 100644 index 0000000000..4c08064670 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl @@ -0,0 +1,73 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that depend on the compiler inliner being turned on. +%%%------------------------------------------------------------------- +-module(basic_inline_function). + +-export([test/0]). + +-compile({inline, [{to_objects, 3}]}). + +test() -> + ok = test_inline_match(), + ok. + +%%-------------------------------------------------------------------- + +test_inline_match() -> + bad_object = test1(a, {binary, foo, set}, c), + bad_object = test2(a, {binary, foo, set}, c), + bad_object = test3(a, {binary, foo, set}, c), + ok. + +%% Inlined +test1(KeysObjs, C, Ts) -> + case catch to_objects(KeysObjs, C, Ts) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% "Inlined" by hand +test2(KeysObjs, C, _Ts) -> + case catch (case C of + {binary, _, set} -> + <<_ObjSz0:32, _T/binary>> = KeysObjs; + _ -> ok + end) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% Not inlined +test3(KeysObjs, C, Ts) -> + case catch fto_objects(KeysObjs, C, Ts) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% Inlined. +to_objects(Bin, {binary, _, set}, _Ts) -> + <<_ObjSz0:32, _T/binary>> = Bin, + ok; +to_objects(<<_ObjSz0:32, _T/binary>> ,_, _) -> + ok; +to_objects(_Bin, _, _Ts) -> + ok. + +%% Not Inlined. +fto_objects(Bin, {binary, _, set}, _Ts) -> + <<_ObjSz0:32, _T/binary>> = Bin, + ok; +fto_objects(<<_ObjSz0:32, _T/binary>> ,_,_) -> + ok; +fto_objects(_Bin, _, _Ts) -> + ok. + diff --git a/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl b/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl new file mode 100644 index 0000000000..306c6a39ce --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl @@ -0,0 +1,31 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that depend on the compiler inliner being turned on. +%%%------------------------------------------------------------------- +-module(basic_inline_module). + +-export([test/0]). + +-compile([inline]). %% necessary for these tests + +test() -> + ok = test_case_end_atom(), + ok. + +%%-------------------------------------------------------------------- +%% Tests whether the translation of a case_end instruction works even +%% when an exception (no matching case pattern) is to be raised. + +test_case_end_atom() -> + {'EXIT',{{case_clause,some_atom},_Trace}} = (catch test_case_stm_inlining()), + ok. + +test_case_stm_inlining() -> + case some_atom() of + another_atom -> strange_result + end. + +some_atom() -> + some_atom. diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl new file mode 100644 index 0000000000..73367c5c45 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl @@ -0,0 +1,326 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples, mostly taken from the mailing list, that +%%% crashed the BEAM compiler or gave an internal error at some point. +%%%------------------------------------------------------------------- +-module(basic_issues_beam). + +-export([test/0]). + +test() -> + ok = test_crash_R10_hinde(), + ok = test_error_R10_mander(), + ok = test_error_R11_bjorklund(), + ok = test_error_R11_rath(), + ok = test_error_R12_empty_bin_rec(), + ok = test_bug_R12_cornish(), + ok = test_crash_R12_morris(), + ok = test_error_R13_almeida(), + ok = test_error_R13B01_fisher(), + ok = test_error_R13B01_sawatari(), + ok = test_error_R13B01_whongo(), + ok = test_error_R16B03_norell(), + ok = test_error_try_wings(), + ok. + +%%-------------------------------------------------------------------- +%% Fisher R10 compiler crash +%%-------------------------------------------------------------------- + +-record(r, {a, b, c}). + +test_crash_R10_hinde() -> + rec_R10_hinde(#r{}). + +rec_R10_hinde(As) -> + case As of + A when A#r.b == ""; A#r.b == undefined -> ok; + _ -> error + end. + +%%-------------------------------------------------------------------- +%% From: Peter-Henry Mander +%% Date: 27 Jan, 2005 +%% +%% I managed to isolate a non-critical BEAM compilation error +%% (internal error in v3_codegen) when compiling the following code: +%%-------------------------------------------------------------------- + +test_error_R10_mander() -> + try just_compile_me_R10() catch _:_ -> ok end. + +just_compile_me_R10() -> + URI_Before = + {absoluteURI, + {scheme, fun() -> nil end}, + {hier_part, + {net_path, + {srvr, + {userinfo, nil}, + fun() -> nil end}, + nil}, + {port, nil}}}, + {absoluteURI, + {scheme, _}, + {hier_part, + {net_path, + {srvr, + {userinfo, nil}, + _HostportBefore}, + nil}, + {port, nil}}} = URI_Before, + %% ... some funky code ommitted, not relevant ... + {absoluteURI, + {scheme, _}, + {hier_part, + {net_path, + {srvr, + {userinfo, nil}, + HostportAfter}, + nil}, + {port, nil}}} = URI_Before, + %% NOTE: I intended to write URI_After instead of URI_Before + %% but the accident revealed that when you add the line below, + %% it causes internal error in v3_codegen on compilation + {hostport, {hostname, "HostName"}, {port, nil}} = HostportAfter, + ok. + +%%-------------------------------------------------------------------- +%% From: Martin Bjorklund +%% Date: Aug 16, 2006 +%% +%% I found this compiler bug in R10B-10 and R11B-0. +%% +%% Function -just_compile_me/0-fun-2-/1 refers to undefined label 18 +%% ./bjorklund_R11compiler_bug.erl:none: internal error in beam_clean; +%% crash reason: {{case_clause,{'EXIT',{undefined_label,18}}}, +%% [{compile,'-select_passes/2-anonymous-2-',2}, +%% {compile,'-internal_comp/4-anonymous-1-',2}, +%% {compile,fold_comp,3}, +%% {compile,internal_comp,4}, +%% {compile,internal,3}]} +%%-------------------------------------------------------------------- + +test_error_R11_bjorklund() -> + just_compile_me_R11_bjorklund(). + +just_compile_me_R11_bjorklund() -> + G = fun() -> ok end, + try + G() %% fun() -> ok end + after + fun({A, B}) -> A + B end + end. + +%%-------------------------------------------------------------------- +%% From: Tim Rath +%% Date: Sep 13, 2006 +%% Subject: Compiler bug not quite fixed +%% +%% +%% I saw a compiler bug posted to the list by Martin Bjorklund that +%% appeared to be exactly the problem I'm seeing, and then noticed +%% that this was fixed in R11B-1. Unfortunately, though R11B-1 appears +%% to fix the code submitted by Martin, it does not fix my case. +%% +%% Function -just_compile_me/0-fun-2-/1 refers to undefined label 13 +%% ./rath_R11compiler_bug.erl:none: internal error in beam_clean; +%% crash reason: {{case_clause,{'EXIT',{undefined_label,13}}}, +%% [{compile,'-select_passes/2-anonymous-2-',2}, +%% {compile,'-internal_comp/4-anonymous-1-',2}, +%% {compile,fold_comp,3}, +%% {compile,internal_comp,4}, +%% {compile,internal,3}]} +%%-------------------------------------------------------------------- + +test_error_R11_rath() -> + just_compile_me_R11_rath(). + +just_compile_me_R11_rath() -> + A = {6}, + try + io:fwrite("") + after + fun () -> + fun () -> {_} = A end + end + end. + +%%---------------------------------------------------------------------- +%% Program that crashed the R12B-0 compiler: internal error in v3_codegen +%%---------------------------------------------------------------------- + +-record(rec, {a = <<>> :: binary(), b = 42 :: integer()}). + +test_error_R12_empty_bin_rec() -> + 42 = test_empty_bin_rec(#rec{}), + ok. + +test_empty_bin_rec(R) -> + #rec{a = <<>>} = R, + R#rec.b. + +%%---------------------------------------------------------------------- +%% From: Simon Cornish +%% Date: Jan 13, 2008 +%% +%% The attached Erlang code demonstrates an R12B-0 bug with funs. +%% Compile and evaluate the two die/1 calls for two different failure modes. +%% It seems to me that the live register check for call_fun is off by one. +%%---------------------------------------------------------------------- + +-record(b, {c}). + +test_bug_R12_cornish() -> + {a2, a} = die(a), + {a2, {b, c}} = die({b, c}), + ok. + +die(A) -> + F = fun() -> {ok, A} end, + if A#b.c =:= [] -> one; + true -> + case F() of + {ok, A2} -> {a2, A2}; + _ -> three + end + end. + +%%---------------------------------------------------------------------- +%% From: Hunter Morris +%% Date: Nov 20, 2008 +%% +%% The following code (tested with R12B-4 or R12B-5, vanilla compiler +%% options) produces a compiler crash. It's nonsensical, and I realise +%% that andalso can be quite evil, but it's a crash nonetheless. +%%---------------------------------------------------------------------- + +test_crash_R12_morris() -> + foo(42). + +foo(Bar) when (is_integer(Bar) andalso Bar =:= 0) ; Bar =:= 42 -> + ok. + +%%-------------------------------------------------------------------- +%% From: Paulo Sergio Almeida +%% Date: May 20, 2009 +%% +%% The following code when compiled under R13B gives a compiler error. +%% Function loop/1 refers to undefined label 6 +%% ./almeida_R13compiler_bug.erl:none: internal error in beam_peep; +%% crash reason: {{case_clause,{'EXIT',{undefined_label,6}}}, +%% [{compile,'-select_passes/2-anonymous-2-',2}, +%% {compile,'-internal_comp/4-anonymous-1-',2}, +%%-------------------------------------------------------------------- + +test_error_R13_almeida() -> + self() ! {backup, 42, false}, + loop([]). + +loop(Tids) -> + receive + {backup, Tid, Dumping} -> + case Dumping of + false -> ok; + _ -> receive {logged, Tab, Tid} -> put({log, Tab}, Tid) end + end, + collect(Tid, Tids, []) + end. + +collect(_, _, _) -> ok. + +%%-------------------------------------------------------------------- +%% Fisher R13B01 compiler error +%%-------------------------------------------------------------------- + +test_error_R13B01_fisher() -> + perform_select({foo, "42"}). + +perform_select({Type, Keyval}) -> + try + if is_atom(Type) andalso length(Keyval) > 0 -> ok; + true -> ok + end + catch + _:_ -> fail + end. + +%%-------------------------------------------------------------------- +%% From: Mikage Sawatari +%% Date: Jun 12, 2009 +%% +%% I have the following compilation problem on Erlang R13B01. +%% Compiler reports "Internal consistency check failed". +%%-------------------------------------------------------------------- + +test_error_R13B01_sawatari() -> + test_sawatari([1, null, 3], <<1, 2, 3>>). + +test_sawatari([], _Bin) -> ok; +test_sawatari([H|T], Bin) -> + _ = case H of + null -> <<Bin/binary>>; + _ -> ok + end, + test_sawatari(T, Bin). + +%%-------------------------------------------------------------------- + +test_error_R13B01_whongo() -> + S = "gazonk", + S = orgno_alphanum(S), + ok. + +orgno_alphanum(Cs) -> + [C || C <- Cs, ((C >= $0) andalso (C =< $9)) + orelse ((C >= $a) andalso (C =< $z)) + orelse ((C >= $A) andalso (C =< $Z))]. + +%%-------------------------------------------------------------------- +%% I'm getting an Internal Consistency Check error when attempting to +%% build Wings3D on Mac OS X 10.4.2 (Erlang OTP R10B-6): +%% +%% erlc -pa /ebin +warn_unused_vars -I/include -I ../e3d -W +debug_info +%% '-Dwings_version="0.98.31"' -pa ../ebin -o../ebin wings_color.erl +%% wings_color: function internal_rgb_to_hsv/3+97: +%% Internal consistency check failed - please report this bug. +%% Instruction: {test,is_eq_exact,{f,80},[{x,0},{atom,error}]} +%% Error: {unsafe_instruction,{float_error_state,cleared}}: +%% +%% The problem is the interaction of the 'try' construct with the +%% handling of FP exceptions. +%%-------------------------------------------------------------------- + +test_error_try_wings() -> + %% a call with a possible FP exception + {199.99999999999997, 0.045454545454545456, 44} = rgb_to_hsv(42, 43, 44), + ok. + +rgb_to_hsv(R, G, B) -> + Max = lists:max([R, G, B]), + Min = lists:min([R, G, B]), + V = Max, + {Hue, Sat} = try + {if Min == B -> (G-Min)/(R+G-2.0*Min); + Min == R -> (1.0+(B-Min)/(B+G-2.0*Min)); + Min == G -> (2.0+(R-Min)/(B+R-2.0*Min)) + end * 120, (Max-Min)/Max} + catch + error:badarith -> {undefined, 0.0} + end, + {Hue, Sat, V}. + +%%-------------------------------------------------------------------- +%% From: Ulf Norell +%% Date: Feb 28, 2014 +%% +%% This caused an internal error in v3_codegen +%%-------------------------------------------------------------------- + +test_error_R16B03_norell() -> + test_error_R16B03_norell(#r{}, gazonk). + +test_error_R16B03_norell(Rec, Tag) -> + is_record(Rec, Tag, 3) orelse ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl new file mode 100644 index 0000000000..e71045bfe2 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl @@ -0,0 +1,153 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that exhibited crashes in the HiPE compiler. +%%%------------------------------------------------------------------- +-module(basic_issues_hipe). + +-export([test/0]). + +%% functions that need to be exported so that they are retained. +-export([auth/4]). + +test() -> + ok = test_dominance_trees(), + ok = test_merged_const(), + ok = test_var_pair(), + ok = test_bif_fails(), + ok = test_find_catches(), + ok = test_heap_allocate_trim(), + ok. + +%%-------------------------------------------------------------------- +%% This is taken from a file sent to us by Martin Bjorklund @ Nortel +%% on 14th November 2004. The problem was in the SSA unconvert pass. +%% +%% No tests here; we simply check that the HiPE compiler does not go +%% into an infinite loop when compiling strange functions like this. +%%-------------------------------------------------------------------- + +auth(_, A, B, C) -> + auth(A, B, C, []). + +%%-------------------------------------------------------------------- +%% Exposed a crash in the generation of dominance trees used in SSA. +%%-------------------------------------------------------------------- + +-record(state, {f}). + +test_dominance_trees() -> + {ok, true} = doit(true, #state{f = true}), + ok. + +doit(Foo, S) -> + Fee = case Foo of + Bar when Bar == S#state.f; Bar == [] -> true; + _ -> false + end, + {ok, Fee}. + +%%-------------------------------------------------------------------- +%% Checks that the merging of constants in the constant table uses the +%% appropriate comparison function for this. +%%-------------------------------------------------------------------- + +test_merged_const() -> + Const1 = {'', 1.0000}, + Const2 = {'', 1}, + match(Const1, Const2). + +match(A, A) -> + error; +match(_A, _B) -> + ok. + +%%-------------------------------------------------------------------- +%% Checks that the HiPE compiler does not get confused by constant +%% data structures similar to the internal compiler data structures. +%%-------------------------------------------------------------------- + +test_var_pair() -> + ok = var_pair([gazonk]). + +var_pair([_|_]) -> + var_pair({var, some_atom}); +var_pair(_) -> + ok. + +%%-------------------------------------------------------------------- +%% This module was causing the HiPE compiler to crash in January 2007. +%% The culprit was an "optimization" of the BEAM compiler: postponing +%% the save of x variables when BIFs cannot fail. This was fixed on +%% February 1st, by making the HiPE compiler use the same functions +%% as the BEAM compiler for deciding whether a BIF fails. +%%-------------------------------------------------------------------- + +test_bif_fails() -> + [42] = bif_fails_in_catch([42]), + true = bif_fails_in_try([42]), + ok. + +bif_fails_in_catch(X) -> + case catch get(gazonk) of + _ -> X + end. + +bif_fails_in_try(X) -> + try + true = X =/= [] + catch + _ -> nil(X) + end. + +nil(_) -> []. + +%%-------------------------------------------------------------------- +%% Test that resulted in a native code compiler crash in the code of +%% hipe_icode_exceptions:find_catches/1 when compiling find_catches/2. +%%-------------------------------------------------------------------- + +test_find_catches() -> + 42 = find_catches(a, false), + ok. + +find_catches(X, Y) -> + case X of + a when Y =:= true -> + catch id(X), + X; + b when Y =:= true -> + catch id(X), + X; + a -> + catch id(X), + 42; + b -> + catch id(X), + 42 + end. + +id(X) -> X. + +%%-------------------------------------------------------------------- +%% Date: Dec 28, 2007 +%% +%% This is a test adapted from the file sent to the Erlang mailing +%% list by Eranga Udesh. The file did not compile because of problems +%% with the heap_allocate instruction and stack trimming. +%%-------------------------------------------------------------------- + +test_heap_allocate_trim() -> + {abandon, 42} = get_next_retry(a, 42), + ok. + +get_next_retry(Error, Count) -> + case catch pair(retry_scheme, {Error, Count}) of + _ -> + case pair(Error, Count) of + _ -> {abandon, Count} + end + end. + +pair(A, B) -> {A, B}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_lists.erl b/lib/hipe/test/basic_SUITE_data/basic_lists.erl new file mode 100644 index 0000000000..264a7f86f6 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_lists.erl @@ -0,0 +1,61 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate and pattern match against lists +%%% (perhaps by calling functions from the 'lists' module). +%%%------------------------------------------------------------------- +-module(basic_lists). + +-export([test/0]). + +test() -> + ok = test_length(), + ok = test_lists_key(), + ok = test_lists_and_strings(), + ok. + +%%-------------------------------------------------------------------- + +test_length() -> + Len = 42, + Lst = mklist(Len, []), + Len = iterate(100, Lst), + ok. + +mklist(0, L) -> L; +mklist(X, L) -> mklist(X-1, [X|L]). + +iterate(0, L) -> len(L, 0); +iterate(X, L) -> len(L, 0), iterate(X-1, L). + +len([_|X], L) -> len(X, L+1); +len([], L) -> L. + +%%-------------------------------------------------------------------- + +test_lists_key() -> + First = {x, 42.0}, + Second = {y, -77}, + Third = {z, [a, b, c], {5.0}}, + List = [First, Second, Third], + {value, First} = key_search_find(42, 2, List), + ok. + +key_search_find(Key, Pos, List) -> + case lists:keyfind(Key, Pos, List) of + false -> + false = lists:keysearch(Key, Pos, List); + Tuple when is_tuple(Tuple) -> + {value, Tuple} = lists:keysearch(Key, Pos, List) + end. + +%%-------------------------------------------------------------------- + +test_lists_and_strings() -> + LL = ["H'A", " H'B", " H'C"], + LL2 = lists:map(fun string:strip/1, LL), + HexFormat = fun(X, Acc) -> {string:substr(X, 3), Acc} end, + {LL3,_Ret} = lists:mapfoldl(HexFormat, 0, LL2), + ["A", "B", "C"] = lists:sublist(LL3, 42), + ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_module_info.erl b/lib/hipe/test/basic_SUITE_data/basic_module_info.erl new file mode 100644 index 0000000000..cab48b10ba --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_module_info.erl @@ -0,0 +1,32 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% Date: Oct 25, 2003 +%%% +%%% Tests whether calling module_info from the same module works. +%%% This seems trivial, but the problem is that the module_info/[0,1] +%%% functions that the BEAM file contains used to be dummy functions +%%% containing crap. So, these functions could not be used for +%%% compilation to native code and the functions that the BEAM loader +%%% generates should have been used instead. This was a HiPE bug +%%% reported by Dan Wallin. +%%%------------------------------------------------------------------- +-module(basic_module_info). + +-export([test/0]). + +test() -> + L = test_local_mi0_call(), + E = test_remote_mi1_call(), + {3, 3} = {L, E}, + ok. + +test_local_mi0_call() -> + ModInfo = module_info(), + %% io:format("ok, ModInfo=~w\n", [ModInfo]), + {exports, FunList} = lists:keyfind(exports, 1, ModInfo), + length(FunList). + +test_remote_mi1_call() -> + FunList = ?MODULE:module_info(exports), + length(FunList). diff --git a/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl new file mode 100644 index 0000000000..93240354a7 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl @@ -0,0 +1,46 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that test pattern matching against terms of +%%% various types. +%%%------------------------------------------------------------------- +-module(basic_pattern_match). + +-export([test/0]). + +test() -> + ok = test_hello_world(), + ok = test_list_plus_plus_match(), + ok. + +%%-------------------------------------------------------------------- +%% Trivial test to test pattern matching compilation with atoms, the +%% correct handling of all sorts of alphanumeric types in Erlang, and +%% conversions between them. + +test_hello_world() -> + String = gimme(string), + String = atom_to_list(gimme(atom)), + String = binary_to_list(gimme(binary)), + true = (list_to_atom(String) =:= gimme(atom)), + true = (list_to_binary(String) =:= gimme(binary)), + ok. + +gimme(string) -> + "hello world"; +gimme(atom) -> + 'hello world'; +gimme(binary) -> + <<"hello world">>. + +%%-------------------------------------------------------------------- +%% Makes sure that pattern matching expressions involving ++ work OK. +%% The third expression caused a problem in the Erlang shell of R11B-5. +%% It worked OK in both interpreted and compiled code. + +test_list_plus_plus_match() -> + ok = (fun("X" ++ _) -> ok end)("X"), + ok = (fun([$X | _]) -> ok end)("X"), + ok = (fun([$X] ++ _) -> ok end)("X"), + ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_random.erl b/lib/hipe/test/basic_SUITE_data/basic_random.erl new file mode 100644 index 0000000000..783947bd31 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_random.erl @@ -0,0 +1,238 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% A test for list handling created using the 'random' module. +%%%------------------------------------------------------------------- +-module(basic_random). + +-export([test/0]). + +%% It can be used as a benchmark by playing with the following defines +-define(N, 1000). +-define(Iter, 500). + +test() -> + ok = random(?N). + +random(N) -> + random(N, ?Iter). + +random(N, Iter) -> + random:seed(1, 2, 3), + t(ranlist(N, [], N*100), Iter). + +ranlist(0, L, _N) -> L; +ranlist(N, L, N0) -> ranlist(N-1, [random:uniform(N0)+300 | L], N0). + +t(_, 0) -> ok; +t(L, Iter) -> + %% io:format("Sort starting~n"), + sort(L), + t(L, Iter-1). + +sort([X, Y | L]) when X =< Y -> + split_1(X, Y, L, [], []); +sort([X, Y | L]) -> + split_2(X, Y, L, [], []); +sort(L) -> + L. + +%% Ascending. +split_1(X, Y, [Z | L], R, Rs) when Z >= Y -> + split_1(Y, Z, L, [X | R], Rs); +split_1(X, Y, [Z | L], R, Rs) when Z >= X -> + split_1(Z, Y, L, [X | R], Rs); +split_1(X, Y, [Z | L], [], Rs) -> + split_1(X, Y, L, [Z], Rs); +split_1(X, Y, [Z | L], R, Rs) -> + split_1_1(X, Y, L, R, Rs, Z); +split_1(X, Y, [], R, Rs) -> + rmergel([[Y, X | R] | Rs], []). + +%% One out-of-order element, S. +split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= Y -> + split_1_1(Y, Z, L, [X | R], Rs, S); +split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= X -> + split_1_1(Z, Y, L, [X | R], Rs, S); +split_1_1(X, Y, [Z | L], R, Rs, S) when S =< Z -> + split_1(S, Z, L, [], [[Y, X | R] | Rs]); +split_1_1(X, Y, [Z | L], R, Rs, S) -> + split_1(Z, S, L, [], [[Y, X | R] | Rs]); +split_1_1(X, Y, [], R, Rs, S) -> + rmergel([[S], [Y, X | R] | Rs], []). + +%% Descending. +split_2(X, Y, [Z | L], R, Rs) when Z =< Y -> + split_2(Y, Z, L, [X | R], Rs); +split_2(X, Y, [Z | L], R, Rs) when Z =< X -> + split_2(Z, Y, L, [X | R], Rs); +split_2(X, Y, [Z | L], [], Rs) -> + split_2(X, Y, L, [Z], Rs); +split_2(X, Y, [Z | L], R, Rs) -> + split_2_1(X, Y, L, R, Rs, Z); +split_2(X, Y, [], R, Rs) -> + mergel([[Y, X | R] | Rs], []). + +split_2_1(X, Y, [Z | L], R, Rs, S) when Z =< Y -> + split_2_1(Y, Z, L, [X | R], Rs, S); +split_2_1(X, Y, [Z | L], R, Rs, S) when Z =< X -> + split_2_1(Z, Y, L, [X | R], Rs, S); +split_2_1(X, Y, [Z | L], R, Rs, S) when S > Z -> + split_2(S, Z, L, [], [[Y, X | R] | Rs]); +split_2_1(X, Y, [Z | L], R, Rs, S) -> + split_2(Z, S, L, [], [[Y, X | R] | Rs]); +split_2_1(X, Y, [], R, Rs, S) -> + mergel([[S], [Y, X | R] | Rs], []). + +mergel([[] | L], Acc) -> + mergel(L, Acc); +mergel([A, [H2 | T2], [H3 | T3] | L], Acc) -> + mergel(L, [merge3_1(A, [], H2, T2, H3, T3) | Acc]); +mergel([A, [H | T]], Acc) -> + rmergel([merge2_1(A, H, T, []) | Acc], []); +mergel([L], []) -> + L; +mergel([L], Acc) -> + rmergel([lists:reverse(L, []) | Acc], []); +mergel([], []) -> + []; +mergel([], Acc) -> + rmergel(Acc, []); +mergel([A, [] | L], Acc) -> + mergel([A | L], Acc); +mergel([A, B, [] | L], Acc) -> + mergel([A, B | L], Acc). + +rmergel([A, [H2 | T2], [H3 | T3] | L], Acc) -> + rmergel(L, [rmerge3_1(A, [], H2, T2, H3, T3) | Acc]); +rmergel([A, [H | T]], Acc) -> + mergel([rmerge2_1(A, H, T, []) | Acc], []); +rmergel([L], Acc) -> + mergel([lists:reverse(L, []) | Acc], []); +rmergel([], Acc) -> + mergel(Acc, []). + +%% Take L1 apart. +merge3_1([H1 | T1], M, H2, T2, H3, T3) when H1 =< H2 -> + merge3_12(T1, H1, H2, T2, H3, T3, M); +merge3_1([H1 | T1], M, H2, T2, H3, T3) -> + merge3_21(T1, H1, H2, T2, H3, T3, M); +merge3_1(_nil, M, H2, T2, H3, T3) when H2 =< H3 -> + merge2_1(T2, H3, T3, [H2 | M]); +merge3_1(_nil, M, H2, T2, H3, T3) -> + merge2_1(T3, H2, T2, [H3 | M]). + +%% Take L2 apart. +merge3_2(T1, H1, M, [H2 | T2], H3, T3) when H1 =< H2 -> + merge3_12(T1, H1, H2, T2, H3, T3, M); +merge3_2(T1, H1, M, [H2 | T2], H3, T3) -> + merge3_21(T1, H1, H2, T2, H3, T3, M); +merge3_2(T1, H1, M, _nil, H3, T3) when H1 =< H3 -> + merge2_1(T1, H3, T3, [H1 | M]); +merge3_2(T1, H1, M, _nil, H3, T3) -> + merge2_1(T3, H1, T1, [H3 | M]). + +%% H1 <= H2. Inlined. +merge3_12(T1, H1, H2, T2, H3, T3, M) when H3 < H1 -> + merge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_12(T1, H1, H2, T2, H3, T3, M) -> + merge3_1(T1, [H1 | M], H2, T2, H3, T3). + +%% H1 <= H2, take L3 apart. +merge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 < H1 -> + merge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) -> + merge3_1(T1, [H1 | M], H2, T2, H3, T3); +merge3_12_3(T1, H1, H2, T2, M, _nil) -> + merge2_1(T1, H2, T2, [H1 | M]). + +%% H1 > H2. Inlined. +merge3_21(T1, H1, H2, T2, H3, T3, M) when H3 < H2 -> + merge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_21(T1, H1, H2, T2, H3, T3, M) -> + merge3_2(T1, H1, [H2 | M], T2, H3, T3). + +%% H1 > H2, take L3 apart. +merge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 < H2 -> + merge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) -> + merge3_2(T1, H1, [H2 | M], T2, H3, T3); +merge3_21_3(T1, H1, H2, T2, M, _nil) -> + merge2_1(T2, H1, T1, [H2 | M]). + +%% Take L1 apart. +rmerge3_1([H1 | T1], M, H2, T2, H3, T3) when H1 > H2 -> + rmerge3_12(T1, H1, H2, T2, H3, T3, M); +rmerge3_1([H1 | T1], M, H2, T2, H3, T3) -> + rmerge3_21(T1, H1, H2, T2, H3, T3, M); +rmerge3_1(_nil, M, H2, T2, H3, T3) when H2 > H3 -> + rmerge2_1(T2, H3, T3, [H2 | M]); +rmerge3_1(_nil, M, H2, T2, H3, T3) -> + rmerge2_1(T3, H2, T2, [H3 | M]). + +%% Take L2 apart. +rmerge3_2(T1, H1, M, [H2 | T2], H3, T3) when H1 > H2 -> + rmerge3_12(T1, H1, H2, T2, H3, T3, M); +rmerge3_2(T1, H1, M, [H2 | T2], H3, T3) -> + rmerge3_21(T1, H1, H2, T2, H3, T3, M); +rmerge3_2(T1, H1, M, _nil, H3, T3) when H1 > H3 -> + rmerge2_1(T1, H3, T3, [H1 | M]); +rmerge3_2(T1, H1, M, _nil, H3, T3) -> + rmerge2_1(T3, H1, T1, [H3 | M]). + +%% H1 > H2. Inlined. +rmerge3_12(T1, H1, H2, T2, H3, T3, M) when H3 >= H1 -> + rmerge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_12(T1, H1, H2, T2, H3, T3, M) -> + rmerge3_1(T1, [H1 | M], H2, T2, H3, T3). + +%% H1 > H2, take L3 apart. +rmerge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 >= H1 -> + rmerge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) -> + rmerge3_1(T1, [H1 | M], H2, T2, H3, T3); +rmerge3_12_3(T1, H1, H2, T2, M, _nil) -> + rmerge2_1(T1, H2, T2, [H1 | M]). + +%% H1 =< H2. Inlined. +rmerge3_21(T1, H1, H2, T2, H3, T3, M) when H3 >= H2 -> + rmerge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_21(T1, H1, H2, T2, H3, T3, M) -> + rmerge3_2(T1, H1, [H2 | M], T2, H3, T3). + +%% H1 =< H2, take L3 apart. +rmerge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 >= H2 -> + rmerge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) -> + rmerge3_2(T1, H1, [H2 | M], T2, H3, T3); +rmerge3_21_3(T1, H1, H2, T2, M, _nil) -> + rmerge2_1(T2, H1, T1, [H2 | M]). + +merge2_1([H1 | T1], H2, T2, M) when H2 < H1 -> + merge2_2(T1, H1, T2, [H2 | M]); +merge2_1([H1 | T1], H2, T2, M) -> + merge2_1(T1, H2, T2, [H1 | M]); +merge2_1(_nil, H2, T2, M) -> + lists:reverse(T2, [H2 | M]). + +merge2_2(T1, H1, [H2 | T2], M) when H1 < H2 -> + merge2_1(T1, H2, T2, [H1 | M]); +merge2_2(T1, H1, [H2 | T2], M) -> + merge2_2(T1, H1, T2, [H2 | M]); +merge2_2(T1, H1, _nil, M) -> + lists:reverse(T1, [H1 | M]). + +rmerge2_1([H1 | T1], H2, T2, M) when H2 >= H1 -> + rmerge2_2(T1, H1, T2, [H2 | M]); +rmerge2_1([H1 | T1], H2, T2, M) -> + rmerge2_1(T1, H2, T2, [H1 | M]); +rmerge2_1(_nil, H2, T2, M) -> + lists:reverse(T2, [H2 | M]). + +rmerge2_2(T1, H1, [H2 | T2], M) when H1 >= H2 -> + rmerge2_1(T1, H2, T2, [H1 | M]); +rmerge2_2(T1, H1, [H2 | T2], M) -> + rmerge2_2(T1, H1, T2, [H2 | M]); +rmerge2_2(T1, H1, _nil, M) -> + lists:reverse(T1, [H1 | M]). diff --git a/lib/hipe/test/basic_SUITE_data/basic_receive.erl b/lib/hipe/test/basic_SUITE_data/basic_receive.erl new file mode 100644 index 0000000000..5f865d7b7a --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_receive.erl @@ -0,0 +1,56 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that test correct handling of receives. +%%%------------------------------------------------------------------- +-module(basic_receive). + +-export([test/0]). + +test() -> + ok = test_wait_timeout(), + ok = test_double_timeout(), + ok = test_reschedule(), + ok. + +%%-------------------------------------------------------------------- + +test_wait_timeout() -> + receive after 42 -> ok end. + +%%-------------------------------------------------------------------- + +test_double_timeout() -> + self() ! foo, + self() ! another_foo, + receive + non_existent -> weird + after 0 -> timeout + end, + receive + foo -> ok + after 1000 -> timeout + end. + +%%-------------------------------------------------------------------- +%% Check that RESCHEDULE returns from BIFs work. + +test_reschedule() -> + erts_debug:set_internal_state(available_internal_state, true), + First = self(), + Second = spawn(fun() -> doit(First) end), + receive + Second -> ok + end, + receive + after 42 -> ok + end, + erts_debug:set_internal_state(hipe_test_reschedule_resume, Second), + ok. + +doit(First) -> + First ! self(), + erts_debug:set_internal_state(hipe_test_reschedule_suspend, 1). + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_records.erl b/lib/hipe/test/basic_SUITE_data/basic_records.erl new file mode 100644 index 0000000000..cbb451196c --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_records.erl @@ -0,0 +1,28 @@ +%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate and pattern match against records. +%%%------------------------------------------------------------------- +-module(basic_records). + +-export([test/0]). + +test() -> + ok = test_rec1(), + ok. + +%%-------------------------------------------------------------------- + +-record(r, {ra}). +-record(s, {sa, sb, sc, sd}). + +test_rec1() -> + R = #r{}, + S = #s{}, + S1 = S#s{sc=R, sd=1}, + R1 = S1#s.sc, + undefined = R1#r.ra, + ok. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl b/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl new file mode 100644 index 0000000000..0f94320a33 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl @@ -0,0 +1,65 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests the strength reduction component of the HiPE compiler. +%%%------------------------------------------------------------------- +-module(basic_strength_reduce). + +-export([test/0]). +%% These functions are exported so as to not remove them by inlining +-export([crash_0/1, crash_1/1, crash_2/1, crash_3/1, bug_div_2N/1]). + +test() -> + ok = test_strength_reduce1(), + ok. + +%%-------------------------------------------------------------------- + +test_strength_reduce1() -> + ok = crash_0(0), + ok = crash_1(42), + ok = crash_2(42), + ok = crash_3(42), + 5 = 42 bsr 3 = bug_div_2N(42), + -6 = -42 bsr 3 = bug_div_2N(-42) - 1, + ok. + +%% This is a crash report by Peter Wang (10 July 2007) triggering an +%% R11B-5 crash: strength reduction could not handle calls with no +%% destination +crash_0(A) -> + case A of + 0 -> + A div 8, + ok + end. + +%% The above was simplified to the following which showed another +%% crash, this time on RTL +crash_1(A) when is_integer(A), A >= 0 -> + A div 8, + ok. + +%% A similar crash like the first one, but in a different place in the +%% code, was triggered by the following code +crash_2(A) when is_integer(A), A >= 0 -> + A div 1, + ok. + +%% A crash similar to the first one happened in the following code +crash_3(A) -> + case A of + 42 -> + A * 0, + ok + end. + +%% Strength reduction for div/2 and rem/2 with a power of 2 +%% should be performed only for non-negative integers +bug_div_2N(X) when is_integer(X), X >= 0 -> + X div 8; +bug_div_2N(X) when is_integer(X), X < 0 -> + X div 8. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_switches.erl b/lib/hipe/test/basic_SUITE_data/basic_switches.erl new file mode 100644 index 0000000000..0a7ae5b8b7 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_switches.erl @@ -0,0 +1,52 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for pattern matching switches. +%%%------------------------------------------------------------------- +-module(basic_switches). + +-export([test/0]). + +test() -> + ok = test_switch_mix(), + ok. + +%%--------------------------------------------------------------------- + +-define(BIG1, 21323233222132323322). +-define(BIG2, 4242424242424242424242424242424242). + +test_switch_mix() -> + small1 = t(42), + small2 = t(17), + big1 = t(?BIG1), + big2 = t(?BIG2), + atom = t(foo), + pid = t(self()), + float = t(4.2), + ok. + +t(V) -> + S = self(), + case V of + 42 -> small1; + 17 -> small2; + ?BIG1 -> big1; + ?BIG2 -> big2; + 1 -> no; + 2 -> no; + 3 -> no; + 4 -> no; + 5 -> no; + 6 -> no; + 7 -> no; + 8 -> no; + foo -> atom; + 9 -> no; + 4.2 -> float; + S -> pid; + _ -> no + end. + +%%--------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl b/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl new file mode 100644 index 0000000000..0124f13df6 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl @@ -0,0 +1,39 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that check that tail recursion optimization occurs. +%%%------------------------------------------------------------------- +-module(basic_tail_rec). + +-export([test/0]). +-export([app0/2]). %% used in an apply/3 call + +test() -> + ok = test_app_tail(), + ok. + +%%-------------------------------------------------------------------- +%% Written by Mikael Pettersson: check that apply is tail recursive. + +%% Increased the following quantity from 20 to 30 so that the test +%% remains valid even with the naive register allocator. - Kostis +-define(SIZE_INCREASE, 30). + +test_app_tail() -> + Inc = start(400), + %% io:format("Inc ~w\n", [Inc]), + case Inc > ?SIZE_INCREASE of + true -> + {error, "apply/3 is not tail recursive in native code"}; + false -> + ok + end. + +start(N) -> + app0(N, hipe_bifs:nstack_used_size()). + +app0(0, Size0) -> + hipe_bifs:nstack_used_size() - Size0; +app0(N, Size) -> + apply(?MODULE, app0, [N-1, Size]). diff --git a/lib/hipe/test/basic_SUITE_data/basic_tuples.erl b/lib/hipe/test/basic_SUITE_data/basic_tuples.erl new file mode 100644 index 0000000000..94c187e364 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_tuples.erl @@ -0,0 +1,177 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate and pattern match against tuples. +%%%------------------------------------------------------------------- +-module(basic_tuples). + +-export([test/0]). + +test() -> + Num = 4711, + ok = test_match({}, {1}, {1,2}, {1,2,3}, {1,2,3,4}, {1,2,3,4,5}, + {1,2,3,4,5,6}, {1,2,3,4,5,6,7}, {1,2,3,4,5,6,7,8}), + ok = test_size({}, {a}, {{a},{b}}, {a,{b},c}), + ok = test_element({}, {a}, {a,b}, Num), + ok = test_setelement({}, {1}, {1,2}, 3, [1,2]), + ok = test_tuple_to_list({}, {a}, {a,b}, {a,b,c}, {a,b,c,d}, Num), + ok = test_list_to_tuple([], [a], [a,b], [a,b,c], [a,b,c,d], Num), + ok = test_tuple_with_case(), + ok = test_tuple_in_guard({a, b}, {a, b, c}), + ok. + +%%-------------------------------------------------------------------- +%% Tests matching of tuples + +test_match(T0, T1, T2, T3, T4, T5, T6, T7, T8) -> + {} = T0, + {1} = T1, + {1, 2} = T2, + {1, 2, 3} = T3, + {1, 2, 3, 4} = T4, + {1, 2, 3, 4, 5} = T5, + {1, 2, 3, 4, 5, 6} = T6, + T6 = {1, 2, 3, 4, 5, 6}, + T7 = {1, 2, 3, 4, 5, 6, 7}, + {1, 2, 3, 4, 5, 6, 7, 8} = T8, + ok. + +%%-------------------------------------------------------------------- +%% Tests the size/1 and tuple_size/1 BIFs. + +test_size(T0, T1, T2, T3) -> + [0, 1, 2, 3] = [size(T) || T <- [T0, T1, T2, T3]], + [0, 1, 2, 3] = [tuple_size(T) || T <- [T0, T1, T2, T3]], + ok. + +%%-------------------------------------------------------------------- +%% Tests element/2. + +test_element(T0, T1, T2, N) -> + a = element(1, T1), + a = element(1, T2), + %% indirect calls to element/2 + List = lists:seq(1, N), + Tuple = list_to_tuple(List), + ok = get_elements(List, Tuple, 1), + %% some cases that throw exceptions + {'EXIT', _} = (catch my_element(0, T2)), + {'EXIT', _} = (catch my_element(3, T2)), + {'EXIT', _} = (catch my_element(1, T0)), + {'EXIT', _} = (catch my_element(1, List)), + {'EXIT', _} = (catch my_element(1, N)), + {'EXIT', _} = (catch my_element(1.5, T2)), + ok. + +my_element(Pos, Term) -> + element(Pos, Term). + +get_elements([Element|Rest], Tuple, Pos) -> + Element = element(Pos, Tuple), + get_elements(Rest, Tuple, Pos + 1); +get_elements([], _Tuple, _Pos) -> + ok. + +%%-------------------------------------------------------------------- +%% Tests set_element/3. + +test_setelement(T0, T1, Pair, Three, L) -> + {x} = setelement(1, T1, x), + {x, 2} = setelement(1, Pair, x), + {1, x} = setelement(2, Pair, x), + %% indirect calls to setelement/3 + Tuple = list_to_tuple(lists:duplicate(2048, x)), + NewTuple = set_all_elements(Tuple, 1), + NewTuple = list_to_tuple(lists:seq(1+7, 2048+7)), + %% the following cases were rewritten to use the Three + %% variable in this weird way so as to silence the compiler + {'EXIT', _} = (catch setelement(Three - Three, Pair, x)), + {'EXIT', _} = (catch setelement(Three, Pair, x)), + {'EXIT', _} = (catch setelement(Three div Three, T0, x)), + {'EXIT', _} = (catch setelement(Three div Three, L, x)), + {'EXIT', _} = (catch setelement(Three / 2, Pair, x)), + ok. + +set_all_elements(Tuple, Pos) when Pos =< tuple_size(Tuple) -> + set_all_elements(setelement(Pos, Tuple, Pos+7), Pos+1); +set_all_elements(Tuple, Pos) when Pos > tuple_size(Tuple) -> + Tuple. + +%%-------------------------------------------------------------------- +%% Tests tuple_to_list/1. + +test_tuple_to_list(T0, T1, T2, T3, T4, Size) -> + [] = tuple_to_list(T0), + [a] = tuple_to_list(T1), + [a, b] = tuple_to_list(T2), + [a, b, c] = tuple_to_list(T3), + [a, b, c, d] = tuple_to_list(T4), + [a, b, c, d] = tuple_to_list(T4), + %% test a big tuple + List = lists:seq(1, Size), + Tuple = list_to_tuple(List), + Size = tuple_size(Tuple), + List = tuple_to_list(Tuple), + %% some cases that should result in errors + {'EXIT', _} = (catch my_tuple_to_list(element(2, T3))), + {'EXIT', _} = (catch my_tuple_to_list(Size)), + ok. + +my_tuple_to_list(X) -> + tuple_to_list(X). + +%%-------------------------------------------------------------------- +%% Tests list_to_tuple/1. + +test_list_to_tuple(L0, L1, L2, L3, L4, Size) -> + {} = list_to_tuple(L0), + {a} = list_to_tuple(L1), + {a, b} = list_to_tuple(L2), + {a, b, c} = list_to_tuple(L3), + {a, b, c, d} = list_to_tuple(L4), + {a, b, c, d, e} = list_to_tuple(L4++[e]), + %% test list_to_tuple with a big list + Tuple = list_to_tuple(lists:seq(1, Size)), + Size = tuple_size(Tuple), + %% some cases that should result in errors + {'EXIT', _} = (catch my_list_to_tuple({a,b})), + {'EXIT', _} = (catch my_list_to_tuple([hd(L1)|hd(L2)])), + ok. + +my_list_to_tuple(X) -> + list_to_tuple(X). + +%%-------------------------------------------------------------------- +%% Tests that a case nested inside a tuple is ok. +%% (This was known to crash earlier versions of BEAM.) + +test_tuple_with_case() -> + {reply, true} = tuple_with_case(), + ok. + +tuple_with_case() -> + %% The following comments apply to the BEAM compiler. + void(), % Reset var count. + {reply, % Compiler will choose {x,1} for tuple. + case void() of % Call will reset var count. + {'EXIT', Reason} -> % Case will return in {x,1} (first free), + {error, Reason}; % but the tuple will be build in {x,1}, + _ -> % so case value is lost and a circular + true % data element is built. + end}. + +void() -> ok. + +%%-------------------------------------------------------------------- +%% Test to build a tuple in a guard. + +test_tuple_in_guard(T2, T3) -> + %% T2 = {a, b}; T3 = {a, b, c} + ok = if T2 == {element(1, T3), element(2, T3)} -> ok; + true -> other + end, + ok = if T3 == {element(1, T3), element(2, T3), element(3, T3)} -> ok; + true -> other + end, + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_add.erl b/lib/hipe/test/bs_SUITE_data/bs_add.erl index af5a3b2f23..4b92e6b413 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_add.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_add.erl @@ -2,7 +2,7 @@ %%------------------------------------------------------------------------- %% The guard in f/3 revealed a problem in the translation of the 'bs_add' %% BEAM instruction to Icode. The fail label was not properly translated. -%% Fixed 3/2/2011. +%% Fixed 3/2/2011. Then in 2015 we found another issue: g/2. Also fixed. %%------------------------------------------------------------------------- -module(bs_add). @@ -10,9 +10,17 @@ test() -> 42 = f(<<12345:16>>, 4711, <<42>>), + true = g(<<1:13>>, 3), %% was handled OK, but + false = g(<<>>, gurka), %% this one leaked badarith ok. f(Bin, A, B) when <<A:9, B:7/binary>> == Bin -> gazonk; f(Bin, _, _) when is_binary(Bin) -> 42. + +%% Complex way of testing (bit_size(Bin) + Len) rem 8 =:= 0 +g(Bin, Len) when is_binary(<<Bin/binary-unit:1, 123:Len>>) -> + true; +g(_, _) -> + false. diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl index 37a54c1981..b9e7d93570 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_construct.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -14,6 +14,11 @@ test() -> 16#10000008 = bit_size(large_bin(1, 2, 3, 4)), ok = bad_ones(), ok = zero_width(), + ok = not_used(), + ok = bad_append(), + ok = system_limit(), + ok = bad_floats(), + ok = huge_binaries(), ok. %%-------------------------------------------------------------------- @@ -142,3 +147,159 @@ zero_width() -> ok. id(X) -> X. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. The test checks that constructed +%% binaries that are not used would still give a `badarg' exception. +%% Problem was that in native code one of them gave `badarith'. + +not_used() -> + ok = not_used1(3, <<"dum">>), + {'EXIT',{badarg,_}} = (catch not_used1(42, "dum_string")), + {'EXIT',{badarg,_}} = (catch not_used2(666, -2)), + {'EXIT',{badarg,_}} = (catch not_used2(666, "bad_size")), % this one + {'EXIT',{badarg,_}} = (catch not_used3(666)), + ok. + +not_used1(I, BinString) -> + <<I:32,BinString/binary>>, + ok. + +not_used2(I, Sz) -> + <<I:Sz>>, + ok. + +not_used3(I) -> + <<I:(-8)>>, + ok. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. + +bad_append() -> + do_bad_append(<<127:1>>, fun append_unit_3/1), + do_bad_append(<<127:2>>, fun append_unit_3/1), + do_bad_append(<<127:17>>, fun append_unit_3/1), + + do_bad_append(<<127:3>>, fun append_unit_4/1), + do_bad_append(<<127:5>>, fun append_unit_4/1), + do_bad_append(<<127:7>>, fun append_unit_4/1), + do_bad_append(<<127:199>>, fun append_unit_4/1), + + do_bad_append(<<127:7>>, fun append_unit_8/1), + do_bad_append(<<127:9>>, fun append_unit_8/1), + + do_bad_append(<<0:8>>, fun append_unit_16/1), + do_bad_append(<<0:15>>, fun append_unit_16/1), + do_bad_append(<<0:17>>, fun append_unit_16/1), + ok. + +do_bad_append(Bin0, Appender) -> + {'EXIT',{badarg,_}} = (catch Appender(Bin0)), + + Bin1 = id(<<0:3,Bin0/bitstring>>), + <<_:3,Bin2/bitstring>> = Bin1, + {'EXIT',{badarg,_}} = (catch Appender(Bin2)), + + %% Create a writable binary. + Empty = id(<<>>), + Bin3 = <<Empty/bitstring,Bin0/bitstring>>, + {'EXIT',{badarg,_}} = (catch Appender(Bin3)), + ok. + +append_unit_3(Bin) -> + <<Bin/binary-unit:3,0:1>>. + +append_unit_4(Bin) -> + <<Bin/binary-unit:4,0:1>>. + +append_unit_8(Bin) -> + <<Bin/binary,0:1>>. + +append_unit_16(Bin) -> + <<Bin/binary-unit:16,0:1>>. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. + +system_limit() -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + {'EXIT',{system_limit,_}} = + (catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>), + {'EXIT',{system_limit,_}} = + (catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>), + {'EXIT',{system_limit,_}} = + (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>), + + %% Would fail to load. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>), + case WordSize of + 4 -> + system_limit_32(); + 8 -> + ok + end. + +system_limit_32() -> + {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), + + %% The size would be silently truncated, resulting in a crash. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>), + + %% Would fail to load. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>), + ok. + +%%-------------------------------------------------------------------- + +bad_floats() -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + {'EXIT',{badarg,_}} = (catch <<3.14:(id(33))/float>>), + {'EXIT',{badarg,_}} = (catch <<3.14:(id(64 bor 32))/float>>), + {'EXIT',{badarg,_}} = (catch <<3.14:(id((1 bsl 28) bor 32))/float>>), + {'EXIT',{system_limit,_}} = (catch <<3.14:(id(1 bsl BitsPerWord))/float>>), + ok. + +%%-------------------------------------------------------------------- +%% A bug in the implementation of binaries compared sizes in bits with sizes in +%% bytes, causing <<0:(id((1 bsl 31)-1))>> to fail to construct with +%% 'system_limit'. +%% <<0:(id((1 bsl 32)-1))>> was succeeding because the comparison was +%% (incorrectly) signed. + +huge_binaries() -> + AlmostIllegal = id(<<0:(id((1 bsl 32)-8))>>), + case erlang:system_info(wordsize) of + 4 -> huge_binaries_32(AlmostIllegal); + 8 -> ok + end, + garbage_collect(), + id(<<0:(id((1 bsl 31)-1))>>), + id(<<0:(id((1 bsl 30)-1))>>), + garbage_collect(), + ok. + +huge_binaries_32(AlmostIllegal) -> + %% Attempt construction of too large binary using bs_init/1 (which takes the + %% number of bytes as an argument, which should be compared to the maximum + %% size in bytes). + {'EXIT',{system_limit,_}} = (catch <<0:32,AlmostIllegal/binary>>), + %% Attempt construction of too large binary using bs_init/1 with a size in + %% bytes that has the msb set (and would be negative if it was signed). + {'EXIT',{system_limit,_}} = + (catch <<0:8, AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary>>), + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_split.erl b/lib/hipe/test/bs_SUITE_data/bs_split.erl index 2e52308a77..617543f789 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_split.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_split.erl @@ -26,13 +26,13 @@ bs1(L, B, Pos, Sz1, Sz2) -> <<B1:Sz1/binary, B2:Sz2/binary>> = B, bs2(L, B, Pos, B1, B2). -bs2(L, B, Pos, B1, B2)-> +bs2(L, B, Pos, B1, B2) -> B1 = list_to_binary(lists:sublist(L, 1, Pos)), bs3(L, B, Pos, B2). bs3(L, B, Pos, B2) -> B2 = list_to_binary(lists:nthtail(Pos, L)), - byte_split(L, B, Pos-1). + byte_split(L, B, Pos - 1). %%-------------------------------------------------------------------- @@ -56,14 +56,14 @@ bit_split_binary2(_Action, _Bin, [], _Bef) -> ok. bit_split_binary3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> Action(Bin, List, Bef, (Aft-Bef) div 8 * 8), - bit_split_binary3(Action, Bin, List, Bef, Aft-8); + bit_split_binary3(Action, Bin, List, Bef, Aft - 8); bit_split_binary3(_, _, _, _, _) -> ok. make_bin_from_list(_List, 0) -> mkbin([]); make_bin_from_list(List, N) -> list_to_binary([make_int(List, 8, 0), - make_bin_from_list(lists:nthtail(8, List), N-8)]). + make_bin_from_list(lists:nthtail(8, List), N - 8)]). make_int(_List, 0, Acc) -> Acc; make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). @@ -101,5 +101,5 @@ z_split(B, N) -> <<_:N/binary>> -> [B]; _ -> - z_split(B, N+1) + z_split(B, N + 1) end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl index f50ae08964..24526f574d 100644 --- a/lib/hipe/test/bs_SUITE_data/bs_utf.erl +++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl @@ -1,18 +1,356 @@ %% -*- erlang-indent-level: 2 -*- %%------------------------------------------------------------------- -%% Purpose: test support for UTF datatypes in binaries - INCOMPLETE +%% Purpose: test support for UTF datatypes in binaries +%% +%% Most of it taken from emulator/test/bs_utf_SUITE.erl %%------------------------------------------------------------------- -module(bs_utf). -export([test/0]). +-include_lib("test_server/include/test_server.hrl"). + test() -> + ok = utf8_cm65(), + ok = utf8_roundtrip(), + ok = utf16_roundtrip(), + ok = utf32_roundtrip(), + %% The following were problematic for the LLVM backend + ok = utf8_illegal_sequences(), + ok = utf16_illegal_sequences(), + ok = utf32_illegal_sequences(), + ok. + +%%------------------------------------------------------------------- +%% A test with construction and matching + +utf8_cm65() -> <<65>> = b65utf8(), ok = m(<<65>>). +b65utf8() -> + <<65/utf8>>. + m(<<65/utf8>>) -> ok. -b65utf8() -> - <<65/utf8>>. +%%------------------------------------------------------------------- + +utf8_roundtrip() -> + ok = utf8_roundtrip(0, 16#D7FF), + ok = utf8_roundtrip(16#E000, 16#10FFFF), + ok. + +utf8_roundtrip(First, Last) when First =< Last -> + Bin = int_to_utf8(First), + Bin = id(<<First/utf8>>), + Bin = id(<<(id(<<>>))/binary,First/utf8>>), + Unaligned = id(<<3:2,First/utf8>>), + <<_:2,Bin/binary>> = Unaligned, + <<First/utf8>> = Bin, + <<First/utf8>> = make_unaligned(Bin), + utf8_roundtrip(First+1, Last); +utf8_roundtrip(_, _) -> + ok. + +%%------------------------------------------------------------------- + +utf16_roundtrip() -> + Big = fun utf16_big_roundtrip/1, + Little = fun utf16_little_roundtrip/1, + PidRefs = [spawn_monitor(fun() -> do_utf16_roundtrip(Fun) end) || + Fun <- [Big,Little]], + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +do_utf16_roundtrip(Fun) -> + do_utf16_roundtrip(0, 16#D7FF, Fun), + do_utf16_roundtrip(16#E000, 16#10FFFF, Fun). + +do_utf16_roundtrip(First, Last, Fun) when First =< Last -> + Fun(First), + do_utf16_roundtrip(First+1, Last, Fun); +do_utf16_roundtrip(_, _, _) -> ok. + +utf16_big_roundtrip(Char) -> + Bin = id(<<Char/utf16>>), + Bin = id(<<(id(<<>>))/binary,Char/utf16>>), + Unaligned = id(<<3:2,Char/utf16>>), + <<_:2,Bin/binary>> = Unaligned, + <<Char/utf16>> = Bin, + <<Char/utf16>> = make_unaligned(Bin), + ok. + +utf16_little_roundtrip(Char) -> + Bin = id(<<Char/little-utf16>>), + Bin = id(<<(id(<<>>))/binary,Char/little-utf16>>), + Unaligned = id(<<3:2,Char/little-utf16>>), + <<_:2,Bin/binary>> = Unaligned, + <<Char/little-utf16>> = Bin, + <<Char/little-utf16>> = make_unaligned(Bin), + ok. + +%%------------------------------------------------------------------- + +utf32_roundtrip() -> + Big = fun utf32_big_roundtrip/1, + Little = fun utf32_little_roundtrip/1, + PidRefs = [spawn_monitor(fun() -> do_utf32_roundtrip(Fun) end) || + Fun <- [Big,Little]], + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +do_utf32_roundtrip(Fun) -> + do_utf32_roundtrip(0, 16#D7FF, Fun), + do_utf32_roundtrip(16#E000, 16#10FFFF, Fun). + +do_utf32_roundtrip(First, Last, Fun) when First =< Last -> + Fun(First), + do_utf32_roundtrip(First+1, Last, Fun); +do_utf32_roundtrip(_, _, _) -> ok. + +utf32_big_roundtrip(Char) -> + Bin = id(<<Char/utf32>>), + Bin = id(<<(id(<<>>))/binary,Char/utf32>>), + Unaligned = id(<<3:2,Char/utf32>>), + <<_:2,Bin/binary>> = Unaligned, + <<Char/utf32>> = Bin, + <<Char/utf32>> = make_unaligned(Bin), + ok. + +utf32_little_roundtrip(Char) -> + Bin = id(<<Char/little-utf32>>), + Bin = id(<<(id(<<>>))/binary,Char/little-utf32>>), + Unaligned = id(<<3:2,Char/little-utf32>>), + <<_:2,Bin/binary>> = Unaligned, + <<Char/little-utf32>> = Bin, + <<Char/little-utf32>> = make_unaligned(Bin), + ok. + +%%------------------------------------------------------------------- + +utf8_illegal_sequences() -> + fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + + %% Illegal first character. + [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)], + + %% Short sequences. + short_sequences(16#80, 16#10FFFF), + + %% Overlong sequences. (Using more bytes than necessary + %% is not allowed.) + overlong(0, 127, 2), + overlong(128, 16#7FF, 3), + overlong(16#800, 16#FFFF, 4), + ok. + +fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <<Char/utf8>>), + Bin = int_to_utf8(Char), + fail(Bin), + fail_range(Char+1, End); +fail_range(_, _) -> ok. + +short_sequences(Char, End) -> + Step = (End - Char) div erlang:system_info(schedulers) + 1, + PidRefs = short_sequences_1(Char, Step, End), + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +short_sequences_1(Char, Step, End) when Char =< End -> + CharEnd = lists:min([Char+Step-1,End]), + [spawn_monitor(fun() -> + %% io:format("~p - ~p\n", [Char, CharEnd]), + do_short_sequences(Char, CharEnd) + end)|short_sequences_1(Char+Step, Step, End)]; +short_sequences_1(_, _, _) -> []. + +do_short_sequences(Char, End) when Char =< End -> + short_sequence(Char), + do_short_sequences(Char+1, End); +do_short_sequences(_, _) -> ok. + +short_sequence(I) -> + case int_to_utf8(I) of + <<S0:3/binary,_:8>> -> + <<S1:2/binary,R1:8>> = S0, + <<S2:1/binary,_:8>> = S1, + fail(S0), + fail(S1), + fail(S2), + fail(<<S2/binary,16#7F,R1,R1>>), + fail(<<S1/binary,16#7F,R1>>), + fail(<<S0/binary,16#7F>>); + <<S0:2/binary,_:8>> -> + <<S1:1/binary,R1:8>> = S0, + fail(S0), + fail(S1), + fail(<<S0/binary,16#7F>>), + fail(<<S1/binary,16#7F>>), + fail(<<S1/binary,16#7F,R1>>); + <<S:1/binary,_:8>> -> + fail(S), + fail(<<S/binary,16#7F>>) + end. + +overlong(Char, Last, NumBytes) when Char =< Last -> + overlong(Char, NumBytes), + overlong(Char+1, Last, NumBytes); +overlong(_, _, _) -> ok. + +overlong(Char, NumBytes) when NumBytes < 5 -> + case int_to_utf8(Char, NumBytes) of + <<Char/utf8>>=Bin -> + ?t:fail({illegal_encoding_accepted,Bin,Char}); + <<OtherChar/utf8>>=Bin -> + ?t:fail({illegal_encoding_accepted,Bin,Char,OtherChar}); + _ -> ok + end, + overlong(Char, NumBytes+1); +overlong(_, _) -> ok. + +fail(Bin) -> + fail_1(Bin), + fail_1(make_unaligned(Bin)). + +fail_1(<<Char/utf8>> = Bin) -> + ?t:fail({illegal_encoding_accepted, Bin, Char}); +fail_1(_) -> ok. + +%%------------------------------------------------------------------- + +utf16_illegal_sequences() -> + utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + utf16_fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + lonely_hi_surrogate(16#D800, 16#DFFF), + leading_lo_surrogate(16#DC00, 16#DFFF), + ok. + +utf16_fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <<Char/big-utf16>>), + {'EXIT', _} = (catch <<Char/little-utf16>>), + utf16_fail_range(Char+1, End); +utf16_fail_range(_, _) -> ok. + +lonely_hi_surrogate(Char, End) when Char =< End -> + BinBig = <<Char:16/big>>, + BinLittle = <<Char:16/little>>, + case {BinBig,BinLittle} of + {<<Bad/big-utf16>>,_} -> + ?t:fail({lonely_hi_surrogate_accepted,Bad}); + {_,<<Bad/little-utf16>>} -> + ?t:fail({lonely_hi_surrogate_accepted,Bad}); + {_,_} -> + ok + end, + lonely_hi_surrogate(Char+1, End); +lonely_hi_surrogate(_, _) -> ok. + +leading_lo_surrogate(Char, End) when Char =< End -> + leading_lo_surrogate(Char, 16#D800, 16#DFFF), + leading_lo_surrogate(Char+1, End); +leading_lo_surrogate(_, _) -> ok. + +leading_lo_surrogate(HiSurr, LoSurr, End) when LoSurr =< End -> + BinBig = <<HiSurr:16/big,LoSurr:16/big>>, + BinLittle = <<HiSurr:16/little,LoSurr:16/little>>, + case {BinBig,BinLittle} of + {<<Bad/big-utf16,_/bits>>,_} -> + ?t:fail({leading_lo_surrogate_accepted,Bad}); + {_,<<Bad/little-utf16,_/bits>>} -> + ?t:fail({leading_lo_surrogate_accepted,Bad}); + {_,_} -> + ok + end, + leading_lo_surrogate(HiSurr, LoSurr+1, End); +leading_lo_surrogate(_, _, _) -> ok. + +%%------------------------------------------------------------------- + +utf32_illegal_sequences() -> + utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + utf32_fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + utf32_fail_range(-100, -1), + ok. + +utf32_fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <<Char/big-utf32>>), + {'EXIT', _} = (catch <<Char/little-utf32>>), + case {<<Char:32>>,<<Char:32/little>>} of + {<<Unexpected/utf32>>,_} -> + ?t:fail(Unexpected); + {_,<<Unexpected/little-utf32>>} -> + ?t:fail(Unexpected); + {_,_} -> ok + end, + utf32_fail_range(Char+1, End); +utf32_fail_range(_, _) -> ok. + +%%------------------------------------------------------------------- +%% This function intentionally allows construction of UTF-8 sequence +%% in illegal ranges. + +int_to_utf8(I) when I =< 16#7F -> + <<I>>; +int_to_utf8(I) when I =< 16#7FF -> + B2 = I, + B1 = (I bsr 6), + <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>; +int_to_utf8(I) when I =< 16#FFFF -> + B3 = I, + B2 = (I bsr 6), + B1 = (I bsr 12), + <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>; +int_to_utf8(I) when I =< 16#3FFFFF -> + B4 = I, + B3 = (I bsr 6), + B2 = (I bsr 12), + B1 = (I bsr 18), + <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>; +int_to_utf8(I) when I =< 16#3FFFFFF -> + B5 = I, + B4 = (I bsr 6), + B3 = (I bsr 12), + B2 = (I bsr 18), + B1 = (I bsr 24), + <<1:1,1:1,1:1,1:1,1:1,0:1,B1:2,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6, + 1:1,0:1,B5:6>>. + +%% int_to_utf8(I, NumberOfBytes) -> Binary. +%% This function can be used to construct overlong sequences. +int_to_utf8(I, 1) -> + <<I>>; +int_to_utf8(I, 2) -> + B2 = I, + B1 = (I bsr 6), + <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>; +int_to_utf8(I, 3) -> + B3 = I, + B2 = (I bsr 6), + B1 = (I bsr 12), + <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>; +int_to_utf8(I, 4) -> + B4 = I, + B3 = (I bsr 6), + B2 = (I bsr 12), + B1 = (I bsr 18), + <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>. + +%%------------------------------------------------------------------- + +make_unaligned(Bin0) when is_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = byte_size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +%%------------------------------------------------------------------- +%% Just to prevent compiler optimizations + +id(X) -> X. diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl index 5f05a716bc..9f5d7421b4 100644 --- a/lib/hipe/test/hipe_testsuite_driver.erl +++ b/lib/hipe/test/hipe_testsuite_driver.erl @@ -176,7 +176,8 @@ run(TestCase, Dir, _OutDir) -> HiPEOpts = try TestCase:hipe_options() catch error:undef -> [] end, {ok, TestCase} = hipe:c(TestCase, HiPEOpts), ok = TestCase:test(), - case is_llvm_opt_available() of + ToLLVM = try TestCase:to_llvm() catch error:undef -> true end, + case ToLLVM andalso hipe:llvm_support_available() of true -> {ok, TestCase} = hipe:c(TestCase, [to_llvm|HiPEOpts]), ok = TestCase:test(); @@ -186,16 +187,3 @@ run(TestCase, Dir, _OutDir) -> %% lists:foreach(fun (DF) -> ok end, % = file:delete(DF) end, %% [filename:join(OutDir, D) || D <- DataFiles]) %% end. - - -%% This function, which is supposed to check whether the right LLVM -%% infrastructure is available, should be probably written in a better -%% and more portable way and moved to the hipe application. - -is_llvm_opt_available() -> - OptStr = os:cmd("opt -version"), - SubStr = "LLVM version ", N = length(SubStr), - case string:str(OptStr, SubStr) of - 0 -> false; - S -> P = S + N, string:sub_string(OptStr, P, P + 2) >= "3.4" - end. diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl new file mode 100644 index 0000000000..9f0830574f --- /dev/null +++ b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl @@ -0,0 +1,28 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%---------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests that when the native code compilation times out or gets killed +%%% for some other reason, the parent process does not also get killed. +%%% +%%% Problem discovered by Bjorn G. on 1/12/2003 and fixed by Kostis. +%%%---------------------------------------------------------------------- + +-module(sanity_comp_timeout). + +-export([test/0, to_llvm/0]). + +test() -> + ok = write_dummy_mod(), + error_logger:tty(false), % disable printouts of error reports + Self = self(), % get the parent process + c:c(dummy_mod, [native, {hipe, [{timeout, 1}]}]), % This will kill the process + Self = self(), % make sure the parent process stays the same + ok. + +to_llvm() -> false. + +write_dummy_mod() -> + Prog = <<"-module(dummy_mod).\n-export([test/0]).\ntest() -> ok.\n">>, + ok = file:write_file("dummy_mod.erl", Prog). + diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl new file mode 100644 index 0000000000..87e746042e --- /dev/null +++ b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl @@ -0,0 +1,21 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%---------------------------------------------------------------------- +%%% Author: Per Gustafsson +%%% +%%% Checks that HiPE's concurrent compilation does not leave any zombie +%%% processes around after compilation has finished. +%%% +%%% This was a bug reported on erlang-bugs (Oct 25, 2007). +%%%---------------------------------------------------------------------- + +-module(sanity_no_zombies). + +-export([test/0, to_llvm/0]). + +test() -> + L = length(processes()), + hipe:c(?MODULE, [concurrent_comp]), % force concurrent compilation + L = length(processes()), + ok. + +to_llvm() -> false. diff --git a/lib/inets/doc/src/notes.xml b/lib/inets/doc/src/notes.xml index c98ec1a9dc..44e1ea9abe 100644 --- a/lib/inets/doc/src/notes.xml +++ b/lib/inets/doc/src/notes.xml @@ -33,7 +33,23 @@ <file>notes.xml</file> </header> - <section><title>Inets 6.1</title> + <section><title>Inets 6.1.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + mod_alias now traverses all aliases picking the longest + match and not the first match.</p> + <p> + Own Id: OTP-13248</p> + </item> + </list> + </section> + +</section> + +<section><title>Inets 6.1</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/inets/src/http_client/httpc.erl b/lib/inets/src/http_client/httpc.erl index e4a6f8f748..85663b5ded 100644 --- a/lib/inets/src/http_client/httpc.erl +++ b/lib/inets/src/http_client/httpc.erl @@ -101,7 +101,8 @@ request(Url, Profile) -> %% {ok, {StatusLine, Headers, Body}} | {ok, {Status, Body}} | %% {ok, RequestId} | {error,Reason} | {ok, {saved_as, FilePath} %% -%% Method - atom() = head | get | put | post | trace | options| delete +%% Method - atom() = head | get | put | patch | post | trace | +%% options | delete %% Request - {Url, Headers} | {Url, Headers, ContentType, Body} %% Url - string() %% HTTPOptions - [HttpOption] @@ -176,8 +177,8 @@ request(Method, request(Method, {Url, Headers, ContentType, Body}, HTTPOptions, Options, Profile) - when ((Method =:= post) orelse (Method =:= put) orelse (Method =:= delete)) andalso - (is_atom(Profile) orelse is_pid(Profile)) -> + when ((Method =:= post) orelse (Method =:= patch) orelse (Method =:= put) orelse + (Method =:= delete)) andalso (is_atom(Profile) orelse is_pid(Profile)) -> ?hcrt("request", [{method, Method}, {url, Url}, {headers, Headers}, diff --git a/lib/inets/src/http_client/httpc_request.erl b/lib/inets/src/http_client/httpc_request.erl index e4451401f4..af4c3f75f2 100644 --- a/lib/inets/src/http_client/httpc_request.erl +++ b/lib/inets/src/http_client/httpc_request.erl @@ -187,7 +187,8 @@ is_client_closing(Headers) -> %%% Internal functions %%%======================================================================== post_data(Method, Headers, {ContentType, Body}, HeadersAsIs) - when (Method =:= post) orelse (Method =:= put) -> + when (Method =:= post) orelse (Method =:= put) + orelse (Method =:= patch) -> NewBody = case Headers#http_request_h.expect of "100-continue" -> ""; diff --git a/lib/inets/src/http_lib/http_uri.erl b/lib/inets/src/http_lib/http_uri.erl index 6fe8c1776d..9940136f5a 100644 --- a/lib/inets/src/http_lib/http_uri.erl +++ b/lib/inets/src/http_lib/http_uri.erl @@ -196,10 +196,10 @@ parse_host_port(_Scheme, DefaultPort, HostPort, _Opts) -> {Host, int_port(Port)}. split_uri(UriPart, SplitChar, NoMatchResult, SkipLeft, SkipRight) -> - case inets_regexp:first_match(UriPart, SplitChar) of - {match, Match, _} -> - {string:substr(UriPart, 1, Match - SkipLeft), - string:substr(UriPart, Match + SkipRight, length(UriPart))}; + case re:run(UriPart, SplitChar, [{capture, first}]) of + {match, [{Match, _}]} -> + {string:substr(UriPart, 1, Match + 1 - SkipLeft), + string:substr(UriPart, Match + 1 + SkipRight, length(UriPart))}; nomatch -> NoMatchResult end. diff --git a/lib/inets/src/http_server/httpd.erl b/lib/inets/src/http_server/httpd.erl index cf02c0e072..e6377b4882 100644 --- a/lib/inets/src/http_server/httpd.erl +++ b/lib/inets/src/http_server/httpd.erl @@ -43,7 +43,7 @@ %%%======================================================================== parse_query(String) -> - {ok, SplitString} = inets_regexp:split(String,"[&;]"), + SplitString = re:split(String,"[&;]", [{return, list}]), foreach(SplitString). reload_config(Config = [Value| _], Mode) when is_tuple(Value) -> @@ -239,14 +239,14 @@ unblock(Addr, Port, Profile) when is_integer(Port) -> foreach([]) -> []; foreach([KeyValue|Rest]) -> - {ok, Plus2Space, _} = inets_regexp:gsub(KeyValue,"[\+]"," "), - case inets_regexp:split(Plus2Space,"=") of - {ok,[Key|Value]} -> - [{http_uri:decode(Key), - http_uri:decode(lists:flatten(Value))}|foreach(Rest)]; - {ok,_} -> - foreach(Rest) - end. + Plus2Space = re:replace(KeyValue,"[\+]"," ", [{return,list}, global]), + case re:split(Plus2Space,"=", [{return, list}]) of + [Key|Value] -> + [{http_uri:decode(Key), + http_uri:decode(lists:flatten(Value))}|foreach(Rest)]; + _ -> + foreach(Rest) + end. make_name(Addr, Port, Profile) -> diff --git a/lib/inets/src/http_server/httpd_conf.erl b/lib/inets/src/http_server/httpd_conf.erl index 62e8a95b19..a7783bc1e9 100644 --- a/lib/inets/src/http_server/httpd_conf.erl +++ b/lib/inets/src/http_server/httpd_conf.erl @@ -232,7 +232,7 @@ load("KeepAliveTimeout " ++ Timeout, []) -> end; load("Modules " ++ Modules, []) -> - {ok, ModuleList} = inets_regexp:split(Modules," "), + ModuleList = re:split(Modules," ", [{return, list}]), {ok, [], {modules,[list_to_atom(X) || X <- ModuleList]}}; load("ServerAdmin " ++ ServerAdmin, []) -> @@ -879,7 +879,7 @@ bootstrap([]) -> bootstrap([Line|Config]) -> case Line of "Modules " ++ Modules -> - {ok, ModuleList} = inets_regexp:split(Modules," "), + ModuleList = re:split(Modules," ", [{return, list}]), TheMods = [list_to_atom(X) || X <- ModuleList], case verify_modules(TheMods) of ok -> @@ -1004,7 +1004,7 @@ read_config_file(Stream, SoFar) -> %% Ignore commented lines for efficiency later .. read_config_file(Stream, SoFar); Line -> - {ok, NewLine, _}=inets_regexp:sub(clean(Line),"[\t\r\f ]"," "), + NewLine = re:replace(clean(Line),"[\t\r\f ]"," ", [{return,list}]), case NewLine of [] -> %% Also ignore empty lines .. @@ -1031,12 +1031,12 @@ parse_mime_types(Stream, MimeTypesList, "") -> parse_mime_types(Stream, MimeTypesList, [$#|_]) -> parse_mime_types(Stream, MimeTypesList); parse_mime_types(Stream, MimeTypesList, Line) -> - case inets_regexp:split(Line, " ") of - {ok, [NewMimeType|Suffixes]} -> + case re:split(Line, " ", [{return, list}]) of + [NewMimeType|Suffixes] -> parse_mime_types(Stream, lists:append(suffixes(NewMimeType,Suffixes), MimeTypesList)); - {ok, _} -> + _ -> {error, ?NICE(Line)} end. @@ -1207,9 +1207,8 @@ error_report(Where,M,F,Error) -> error_logger:error_report([{?MODULE, Where}, {apply, {M, F, []}}, Error]). white_space_clean(String) -> - {ok,CleanedString,_} = - inets_regexp:gsub(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$",""), - CleanedString. + re:replace(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$","", + [{return,list}, global]). %%%========================================================================= @@ -1246,22 +1245,23 @@ is_file(_Type,_Access,FileInfo,_File) -> {error,FileInfo}. make_integer(String) -> - case inets_regexp:match(string:strip(String),"[0-9]+") of - {match, _, _} -> + case re:run(string:strip(String),"[0-9]+", [{capture, none}]) of + match -> {ok, list_to_integer(string:strip(String))}; nomatch -> {error, nomatch} end. clean(String) -> - {ok,CleanedString,_} = - inets_regexp:gsub(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$",""), - CleanedString. + re:replace(String, "^[ \t\n\r\f]*|[ \t\n\r\f]*\$","", + [{return,list}, global]). custom_clean(String,MoreBefore,MoreAfter) -> - {ok,CleanedString,_} = inets_regexp:gsub(String,"^[ \t\n\r\f"++MoreBefore++ - "]*|[ \t\n\r\f"++MoreAfter++"]*\$",""), - CleanedString. + re:replace(String, + "^[ \t\n\r\f"++MoreBefore++ + "]*|[ \t\n\r\f"++MoreAfter++"]*\$","", + [{return,list}, global]). + check_enum(_Enum,[]) -> {error, not_valid}; diff --git a/lib/inets/src/http_server/httpd_request.erl b/lib/inets/src/http_server/httpd_request.erl index abcc0ce898..749f58c197 100644 --- a/lib/inets/src/http_server/httpd_request.erl +++ b/lib/inets/src/http_server/httpd_request.erl @@ -86,7 +86,8 @@ body_data(Headers, Body) -> %%------------------------------------------------------------------------- %% validate(Method, Uri, Version) -> ok | {error, {bad_request, Reason} | %% {error, {not_supported, {Method, Uri, Version}} -%% Method = "HEAD" | "GET" | "POST" | "TRACE" | "PUT" | "DELETE" +%% Method = "HEAD" | "GET" | "POST" | "PATCH" | "TRACE" | "PUT" +%% | "DELETE" %% Uri = uri() %% Version = "HTTP/N.M" %% Description: Checks that HTTP-request-line is valid. @@ -105,6 +106,8 @@ validate("DELETE", Uri, "HTTP/1." ++ _N) -> validate_uri(Uri); validate("POST", Uri, "HTTP/1." ++ _N) -> validate_uri(Uri); +validate("PATCH", Uri, "HTTP/1." ++ _N) -> + validate_uri(Uri); validate("TRACE", Uri, "HTTP/1." ++ N) when hd(N) >= $1 -> validate_uri(Uri); validate(Method, Uri, Version) -> diff --git a/lib/inets/src/http_server/httpd_script_env.erl b/lib/inets/src/http_server/httpd_script_env.erl index 21b22f4420..232bf96bd4 100644 --- a/lib/inets/src/http_server/httpd_script_env.erl +++ b/lib/inets/src/http_server/httpd_script_env.erl @@ -104,7 +104,7 @@ create_http_header_elements(ScriptType, [{Name, [Value | _] = Values } | create_http_header_elements(ScriptType, [{Name, Value} | Headers], Acc) when is_list(Value) -> - {ok, NewName, _} = inets_regexp:gsub(Name,"-","_"), + NewName = re:replace(Name,"-","_", [{return,list}, global]), Element = http_env_element(ScriptType, NewName, Value), create_http_header_elements(ScriptType, Headers, [Element | Acc]). diff --git a/lib/inets/src/http_server/httpd_util.erl b/lib/inets/src/http_server/httpd_util.erl index ab43f0b378..6dd6db6a0c 100644 --- a/lib/inets/src/http_server/httpd_util.erl +++ b/lib/inets/src/http_server/httpd_util.erl @@ -420,11 +420,11 @@ flatlength([],L) -> %% split_path split_path(Path) -> - case inets_regexp:match(Path,"[\?].*\$") of + case re:run(Path,"[\?].*\$", [{capture, first}]) of %% A QUERY_STRING exists! - {match,Start,Length} -> - {http_uri:decode(string:substr(Path,1,Start-1)), - string:substr(Path,Start,Length)}; + {match,[{Start,Length}]} -> + {http_uri:decode(string:substr(Path,1,Start)), + string:substr(Path,Start+1,Length)}; %% A possible PATH_INFO exists! nomatch -> split_path(Path,[]) @@ -522,25 +522,8 @@ remove_ws(Rest) -> %% split -split(String,RegExp,Limit) -> - case inets_regexp:parse(RegExp) of - {error,Reason} -> - {error,Reason}; - {ok,_} -> - {ok,do_split(String,RegExp,Limit)} - end. - -do_split(String, _RegExp, 1) -> - [String]; - -do_split(String,RegExp,Limit) -> - case inets_regexp:first_match(String,RegExp) of - {match,Start,Length} -> - [string:substr(String,1,Start-1)| - do_split(lists:nthtail(Start+Length-1,String),RegExp,Limit-1)]; - nomatch -> - [String] - end. +split(String,RegExp,N) -> + {ok, re:split(String, RegExp, [{parts, N}, {return, list}])}. %% make_name/2, make_name/3 %% Prefix -> string() diff --git a/lib/inets/src/http_server/mod_actions.erl b/lib/inets/src/http_server/mod_actions.erl index d879328876..154fde294e 100644 --- a/lib/inets/src/http_server/mod_actions.erl +++ b/lib/inets/src/http_server/mod_actions.erl @@ -81,18 +81,18 @@ script(RequestURI, Method, [_ | Rest]) -> %% load load("Action "++ Action, []) -> - case inets_regexp:split(Action, " ") of - {ok,[MimeType, CGIScript]} -> - {ok,[],{action, {MimeType, CGIScript}}}; - {ok,_} -> - {error,?NICE(string:strip(Action)++" is an invalid Action")} + case re:split(Action, " ", [{return, list}]) of + [MimeType, CGIScript] -> + {ok,[],{action, {MimeType, CGIScript}}}; + _ -> + {error,?NICE(string:strip(Action)++" is an invalid Action")} end; load("Script " ++ Script,[]) -> - case inets_regexp:split(Script, " ") of - {ok,[Method, CGIScript]} -> - {ok,[],{script, {Method, CGIScript}}}; - {ok,_} -> - {error,?NICE(string:strip(Script)++" is an invalid Script")} + case re:split(Script, " ", [{return, list}]) of + [Method, CGIScript] -> + {ok,[],{script, {Method, CGIScript}}}; + _ -> + {error,?NICE(string:strip(Script)++" is an invalid Script")} end. store({action, {MimeType, CGIScript}} = Conf, _) when is_list(MimeType), diff --git a/lib/inets/src/http_server/mod_alias.erl b/lib/inets/src/http_server/mod_alias.erl index 8dd4871821..727f6e0ce3 100644 --- a/lib/inets/src/http_server/mod_alias.erl +++ b/lib/inets/src/http_server/mod_alias.erl @@ -113,32 +113,52 @@ real_name(ConfigDB, RequestURI, []) -> httpd_util:split_path(default_index(ConfigDB, RealName)), {ShortPath, Path, AfterPath}; -real_name(ConfigDB, RequestURI, [{MP,Replacement}|Rest]) +real_name(ConfigDB, RequestURI, [{MP,Replacement}| _] = Aliases) when element(1, MP) =:= re_pattern -> - case re:run(RequestURI, MP, [{capture,[]}]) of - match -> + case longest_match(Aliases, RequestURI) of + {match, {MP, Replacement}} -> NewURI = re:replace(RequestURI, MP, Replacement, [{return,list}]), {ShortPath,_} = httpd_util:split_path(NewURI), {Path,AfterPath} = httpd_util:split_path(default_index(ConfigDB, NewURI)), {ShortPath, Path, AfterPath}; nomatch -> - real_name(ConfigDB, RequestURI, Rest) + real_name(ConfigDB, RequestURI, []) end; -real_name(ConfigDB, RequestURI, [{FakeName,RealName}|Rest]) -> - case inets_regexp:match(RequestURI, "^" ++ FakeName) of - {match, _, _} -> - {ok, ActualName, _} = inets_regexp:sub(RequestURI, - "^" ++ FakeName, RealName), +real_name(ConfigDB, RequestURI, [{_,_}|_] = Aliases) -> + case longest_match(Aliases, RequestURI) of + {match, {FakeName, RealName}} -> + ActualName = re:replace(RequestURI, + "^" ++ FakeName, RealName, [{return,list}]), {ShortPath, _AfterPath} = httpd_util:split_path(ActualName), {Path, AfterPath} = - httpd_util:split_path(default_index(ConfigDB, ActualName)), + httpd_util:split_path(default_index(ConfigDB, ActualName)), {ShortPath, Path, AfterPath}; - nomatch -> - real_name(ConfigDB, RequestURI, Rest) + nomatch -> + real_name(ConfigDB, RequestURI, []) end. +longest_match(Aliases, RequestURI) -> + longest_match(Aliases, RequestURI, _LongestNo = 0, _LongestAlias = undefined). + +longest_match([{FakeName, RealName} | Rest], RequestURI, LongestNo, LongestAlias) -> + case re:run(RequestURI, "^" ++ FakeName, [{capture, first}]) of + {match, [{_, Length}]} -> + if + Length > LongestNo -> + longest_match(Rest, RequestURI, Length, {FakeName, RealName}); + true -> + longest_match(Rest, RequestURI, LongestNo, LongestAlias) + end; + nomatch -> + longest_match(Rest, RequestURI, LongestNo, LongestAlias) + end; +longest_match([], _RequestURI, 0, _LongestAlias) -> + nomatch; +longest_match([], _RequestURI, _LongestNo, LongestAlias) -> + {match, LongestAlias}. + %% real_script_name real_script_name(_ConfigDB, _RequestURI, []) -> @@ -146,7 +166,7 @@ real_script_name(_ConfigDB, _RequestURI, []) -> real_script_name(ConfigDB, RequestURI, [{MP,Replacement} | Rest]) when element(1, MP) =:= re_pattern -> - case re:run(RequestURI, MP, [{capture,[]}]) of + case re:run(RequestURI, MP, [{capture, none}]) of match -> ActualName = re:replace(RequestURI, MP, Replacement, [{return,list}]), @@ -156,10 +176,10 @@ real_script_name(ConfigDB, RequestURI, [{MP,Replacement} | Rest]) end; real_script_name(ConfigDB, RequestURI, [{FakeName,RealName} | Rest]) -> - case inets_regexp:match(RequestURI, "^" ++ FakeName) of - {match,_,_} -> - {ok, ActualName, _} = - inets_regexp:sub(RequestURI, "^" ++ FakeName, RealName), + case re:run(RequestURI, "^" ++ FakeName, [{capture, none}]) of + match -> + ActualName = + re:replace(RequestURI, "^" ++ FakeName, RealName, [{return,list}]), httpd_util:split_script_path(default_index(ConfigDB, ActualName)); nomatch -> real_script_name(ConfigDB, RequestURI, Rest) @@ -206,26 +226,26 @@ path(Data, ConfigDB, RequestURI) -> %% load load("DirectoryIndex " ++ DirectoryIndex, []) -> - {ok, DirectoryIndexes} = inets_regexp:split(DirectoryIndex," "), + DirectoryIndexes = re:split(DirectoryIndex," ", [{return, list}]), {ok,[], {directory_index, DirectoryIndexes}}; load("Alias " ++ Alias, []) -> - case inets_regexp:split(Alias," ") of - {ok, [FakeName, RealName]} -> + case re:split(Alias," ", [{return, list}]) of + [FakeName, RealName] -> {ok,[],{alias,{FakeName,RealName}}}; - {ok, _} -> + _ -> {error,?NICE(string:strip(Alias)++" is an invalid Alias")} end; load("ReWrite " ++ Rule, Acc) -> load_re_write(Rule, Acc, "ReWrite", re_write); load("ScriptAlias " ++ ScriptAlias, []) -> - case inets_regexp:split(ScriptAlias, " ") of - {ok, [FakeName, RealName]} -> + case re:split(ScriptAlias, " ", [{return, list}]) of + [FakeName, RealName] -> %% Make sure the path always has a trailing slash.. RealName1 = filename:join(filename:split(RealName)), {ok, [], {script_alias, {FakeName, RealName1++"/"}}}; - {ok, _} -> + _ -> {error, ?NICE(string:strip(ScriptAlias)++ - " is an invalid ScriptAlias")} + " is an invalid ScriptAlias")} end; load("ScriptReWrite " ++ Rule, Acc) -> load_re_write(Rule, Acc, "ScriptReWrite", script_re_write). diff --git a/lib/inets/src/http_server/mod_auth.erl b/lib/inets/src/http_server/mod_auth.erl index 6195e1c69f..b03629cabe 100644 --- a/lib/inets/src/http_server/mod_auth.erl +++ b/lib/inets/src/http_server/mod_auth.erl @@ -168,38 +168,38 @@ load("AuthDBType " ++ Type, end; load("require " ++ Require,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Require," ") of - {ok,["user"|Users]} -> + case re:split(Require," ", [{return, list}]) of + ["user" | Users] -> {ok,[{directory, {Directory, - [{require_user,Users}|DirData]}} | Rest]}; - {ok,["group"|Groups]} -> + [{require_user,Users}|DirData]}} | Rest]}; + ["group"|Groups] -> {ok,[{directory, {Directory, - [{require_group,Groups}|DirData]}} | Rest]}; - {ok,_} -> + [{require_group,Groups}|DirData]}} | Rest]}; + _ -> {error,?NICE(string:strip(Require) ++" is an invalid require")} end; load("allow " ++ Allow,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Allow," ") of - {ok,["from","all"]} -> + case re:split(Allow," ", [{return, list}]) of + ["from","all"] -> {ok,[{directory, {Directory, [{allow_from,all}|DirData]}} | Rest]}; - {ok,["from"|Hosts]} -> + ["from"|Hosts] -> {ok,[{directory, {Directory, [{allow_from,Hosts}|DirData]}} | Rest]}; - {ok,_} -> + _ -> {error,?NICE(string:strip(Allow) ++" is an invalid allow")} end; load("deny " ++ Deny,[{directory, {Directory, DirData}}|Rest]) -> - case inets_regexp:split(Deny," ") of - {ok, ["from", "all"]} -> + case re:split(Deny," ", [{return, list}]) of + ["from", "all"] -> {ok,[{{directory, Directory, [{deny_from, all}|DirData]}} | Rest]}; - {ok, ["from"|Hosts]} -> + ["from"|Hosts] -> {ok,[{{directory, Directory, [{deny_from, Hosts}|DirData]}} | Rest]}; - {ok, _} -> + _ -> {error,?NICE(string:strip(Deny) ++" is an invalid deny")} end; @@ -561,12 +561,12 @@ secret_path(_Path, [], to_be_found) -> secret_path(_Path, [], Directory) -> {yes, Directory}; secret_path(Path, [[NewDirectory] | Rest], Directory) -> - case inets_regexp:match(Path, NewDirectory) of - {match, _, _} when Directory =:= to_be_found -> + case re:run(Path, NewDirectory, [{capture, first}]) of + {match, _} when Directory =:= to_be_found -> secret_path(Path, Rest, NewDirectory); - {match, _, Length} when Length > length(Directory)-> + {match, [{_, Length}]} when Length > length(Directory)-> secret_path(Path, Rest,NewDirectory); - {match, _, _Length} -> + {match, _} -> secret_path(Path, Rest, Directory); nomatch -> secret_path(Path, Rest, Directory) @@ -588,8 +588,8 @@ validate_addr(_RemoteAddr, none) -> % When called from 'deny' validate_addr(_RemoteAddr, []) -> false; validate_addr(RemoteAddr, [HostRegExp | Rest]) -> - case inets_regexp:match(RemoteAddr, HostRegExp) of - {match,_,_} -> + case re:run(RemoteAddr, HostRegExp, [{capture, none}]) of + match -> true; nomatch -> validate_addr(RemoteAddr,Rest) diff --git a/lib/inets/src/http_server/mod_auth_plain.erl b/lib/inets/src/http_server/mod_auth_plain.erl index e85d3b8776..1a3120e03c 100644 --- a/lib/inets/src/http_server/mod_auth_plain.erl +++ b/lib/inets/src/http_server/mod_auth_plain.erl @@ -244,11 +244,11 @@ parse_group(Stream, GroupList, "") -> parse_group(Stream, GroupList, [$#|_]) -> parse_group(Stream, GroupList); parse_group(Stream, GroupList, Line) -> - case inets_regexp:split(Line, ":") of - {ok, [Group,Users]} -> - {ok, UserList} = inets_regexp:split(Users," "), + case re:split(Line, ":", [{return, list}]) of + [Group,Users] -> + UserList = re:split(Users," ", [{return, list}]), parse_group(Stream, [{Group,UserList}|GroupList]); - {ok, _} -> + _ -> {error, ?NICE(Line)} end. @@ -278,10 +278,10 @@ parse_passwd(Stream, PasswdList, "") -> parse_passwd(Stream, PasswdList, [$#|_]) -> parse_passwd(Stream, PasswdList); parse_passwd(Stream, PasswdList, Line) -> - case inets_regexp:split(Line,":") of - {ok, [User,Password]} -> + case re:split(Line,":", [{return, list}]) of + [User,Password] -> parse_passwd(Stream, [{User,Password, []}|PasswdList]); - {ok,_} -> + _ -> {error, ?NICE(Line)} end. diff --git a/lib/inets/src/http_server/mod_browser.erl b/lib/inets/src/http_server/mod_browser.erl index ca643ab728..e3c41793ae 100644 --- a/lib/inets/src/http_server/mod_browser.erl +++ b/lib/inets/src/http_server/mod_browser.erl @@ -98,9 +98,9 @@ getBrowser1(Info) -> getBrowser(AgentString) -> LAgentString = http_util:to_lower(AgentString), - case inets_regexp:first_match(LAgentString,"^[^ ]*") of - {match,Start,Length} -> - Browser = lists:sublist(LAgentString,Start,Length), + case re:run(LAgentString,"^[^ ]*", [{capture, first}]) of + {match,[{Start,Length}]} -> + Browser = lists:sublist(LAgentString,Start+1,Length), case browserType(Browser) of {mozilla,Vsn} -> {getMozilla(LAgentString, @@ -164,8 +164,8 @@ operativeSystem(OpString,[{RetVal,RegExps}|Rest]) -> controlOperativeSystem(_OpString,[]) -> false; controlOperativeSystem(OpString,[Regexp|Regexps]) -> - case inets_regexp:match(OpString,Regexp) of - {match,_,_} -> + case re:run(OpString,Regexp, [{capture, none}]) of + match -> true; nomatch -> controlOperativeSystem(OpString,Regexps) @@ -182,18 +182,19 @@ controlOperativeSystem(OpString,[Regexp|Regexps]) -> getMozilla(_AgentString,[],Default) -> Default; getMozilla(AgentString,[{Agent,AgentRegExp}|Rest],Default) -> - case inets_regexp:match(AgentString,AgentRegExp) of - {match,_,_} -> + case re:run(AgentString,AgentRegExp, [{capture, none}]) of + match -> {Agent,getMozVersion(AgentString,AgentRegExp)}; nomatch -> getMozilla(AgentString,Rest,Default) end. getMozVersion(AgentString, AgentRegExp) -> - case inets_regexp:match(AgentString,AgentRegExp++"[0-9\.\ \/]*") of - {match,Start,Length} when length(AgentRegExp) < Length -> + case re:run(AgentString,AgentRegExp++"[0-9\.\ \/]*", + [{capture, first}]) of + {match, [{Start,Length}]} when length(AgentRegExp) < Length -> %% Ok we got the number split it out - RealStart = Start+length(AgentRegExp), + RealStart = Start+1+length(AgentRegExp), RealLength = Length-length(AgentRegExp), VsnString = string:substr(AgentString,RealStart,RealLength), %% case string:strip(VsnString,both,$\ ) of diff --git a/lib/inets/src/http_server/mod_cgi.erl b/lib/inets/src/http_server/mod_cgi.erl index 25d9f05028..ec8b9be32e 100644 --- a/lib/inets/src/http_server/mod_cgi.erl +++ b/lib/inets/src/http_server/mod_cgi.erl @@ -337,6 +337,8 @@ script_elements(#mod{method = "GET"}, {PathInfo, QueryString}) -> [{query_string, QueryString}, {path_info, PathInfo}]; script_elements(#mod{method = "POST", entity_body = Body}, _) -> [{entity_body, Body}]; +script_elements(#mod{method = "PATCH", entity_body = Body}, _) -> + [{entity_body, Body}]; script_elements(#mod{method = "PUT", entity_body = Body}, _) -> [{entity_body, Body}]; script_elements(_, _) -> diff --git a/lib/inets/src/http_server/mod_dir.erl b/lib/inets/src/http_server/mod_dir.erl index 9d848ac013..2d8f27af3c 100644 --- a/lib/inets/src/http_server/mod_dir.erl +++ b/lib/inets/src/http_server/mod_dir.erl @@ -125,12 +125,13 @@ header(Path,RequestURI) -> RequestURI ++ "</H1>\n<PRE><IMG SRC=\"" ++ icon(blank) ++ "\" ALT=" "> Name Last modified " "Size Description <HR>\n", - case inets_regexp:sub(RequestURI,"[^/]*\$","") of - {ok,"/",_} -> + case re:replace(RequestURI,"[^/]*\$","", [{return,list}]) of + "/" -> Header; - {ok,ParentRequestURI,_} -> - {ok,ParentPath,_} = - inets_regexp:sub(string:strip(Path,right,$/),"[^/]*\$",""), + ParentRequestURI -> + ParentPath = + re:replace(string:strip(Path,right,$/),"[^/]*\$","", + [{return,list}]), Header++format(ParentPath,ParentRequestURI) end. diff --git a/lib/inets/src/http_server/mod_disk_log.erl b/lib/inets/src/http_server/mod_disk_log.erl index a0ff929a34..5e395a2118 100644 --- a/lib/inets/src/http_server/mod_disk_log.erl +++ b/lib/inets/src/http_server/mod_disk_log.erl @@ -138,8 +138,8 @@ do(Info) -> %% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS %%------------------------------------------------------------------------- load("TransferDiskLogSize " ++ TransferDiskLogSize, []) -> - case inets_regexp:split(TransferDiskLogSize," ") of - {ok,[MaxBytes,MaxFiles]} -> + try re:split(TransferDiskLogSize, " ", [{return, list}]) of + [MaxBytes, MaxFiles] -> case make_integer(MaxBytes) of {ok,MaxBytesInteger} -> case make_integer(MaxFiles) of @@ -151,17 +151,20 @@ load("TransferDiskLogSize " ++ TransferDiskLogSize, []) -> ?NICE(string:strip(TransferDiskLogSize)++ " is an invalid TransferDiskLogSize")} end; - {error,_} -> + _ -> {error,?NICE(string:strip(TransferDiskLogSize)++ - " is an invalid TransferDiskLogSize")} + " is an invalid TransferDiskLogSize")} end + catch _:_ -> + {error,?NICE(string:strip(TransferDiskLogSize) ++ + " is an invalid TransferDiskLogSize")} end; load("TransferDiskLog " ++ TransferDiskLog,[]) -> {ok,[],{transfer_disk_log,string:strip(TransferDiskLog)}}; load("ErrorDiskLogSize " ++ ErrorDiskLogSize, []) -> - case inets_regexp:split(ErrorDiskLogSize," ") of - {ok,[MaxBytes,MaxFiles]} -> + try re:split(ErrorDiskLogSize," ", [{return, list}]) of + [MaxBytes,MaxFiles] -> case make_integer(MaxBytes) of {ok,MaxBytesInteger} -> case make_integer(MaxFiles) of @@ -176,13 +179,16 @@ load("ErrorDiskLogSize " ++ ErrorDiskLogSize, []) -> {error,?NICE(string:strip(ErrorDiskLogSize)++ " is an invalid ErrorDiskLogSize")} end + catch _:_ -> + {error,?NICE(string:strip(ErrorDiskLogSize) ++ + " is an invalid TransferDiskLogSize")} end; load("ErrorDiskLog " ++ ErrorDiskLog, []) -> {ok, [], {error_disk_log, string:strip(ErrorDiskLog)}}; load("SecurityDiskLogSize " ++ SecurityDiskLogSize, []) -> - case inets_regexp:split(SecurityDiskLogSize, " ") of - {ok, [MaxBytes, MaxFiles]} -> + try re:split(SecurityDiskLogSize, " ", [{return, list}]) of + [MaxBytes, MaxFiles] -> case make_integer(MaxBytes) of {ok, MaxBytesInteger} -> case make_integer(MaxFiles) of @@ -198,6 +204,9 @@ load("SecurityDiskLogSize " ++ SecurityDiskLogSize, []) -> {error, ?NICE(string:strip(SecurityDiskLogSize) ++ " is an invalid SecurityDiskLogSize")} end + catch _:_ -> + {error,?NICE(string:strip(SecurityDiskLogSize) ++ + " is an invalid SecurityDiskLogSize")} end; load("SecurityDiskLog " ++ SecurityDiskLog, []) -> {ok, [], {security_disk_log, string:strip(SecurityDiskLog)}}; diff --git a/lib/inets/src/http_server/mod_esi.erl b/lib/inets/src/http_server/mod_esi.erl index 1923411449..2978ac9095 100644 --- a/lib/inets/src/http_server/mod_esi.erl +++ b/lib/inets/src/http_server/mod_esi.erl @@ -96,26 +96,27 @@ do(ModData) -> %% Description: See httpd(3) ESWAPI CALLBACK FUNCTIONS %%------------------------------------------------------------------------- load("ErlScriptAlias " ++ ErlScriptAlias, []) -> - case inets_regexp:split(ErlScriptAlias," ") of - {ok, [ErlName | StrModules]} -> + try re:split(ErlScriptAlias," ", [{return, list}]) of + [ErlName | StrModules] -> Modules = lists:map(fun(Str) -> list_to_atom(string:strip(Str)) end, StrModules), - {ok, [], {erl_script_alias, {ErlName, Modules}}}; - {ok, _} -> + {ok, [], {erl_script_alias, {ErlName, Modules}}} + catch _:_ -> {error, ?NICE(string:strip(ErlScriptAlias) ++ - " is an invalid ErlScriptAlias")} + " is an invalid ErlScriptAlias")} end; load("EvalScriptAlias " ++ EvalScriptAlias, []) -> - case inets_regexp:split(EvalScriptAlias, " ") of - {ok, [EvalName | StrModules]} -> + try re:split(EvalScriptAlias, " ", [{return, list}]) of + [EvalName | StrModules] -> Modules = lists:map(fun(Str) -> list_to_atom(string:strip(Str)) end, StrModules), - {ok, [], {eval_script_alias, {EvalName, Modules}}}; - {ok, _} -> + {ok, [], {eval_script_alias, {EvalName, Modules}}} + catch + _:_ -> {error, ?NICE(string:strip(EvalScriptAlias) ++ - " is an invalid EvalScriptAlias")} + " is an invalid EvalScriptAlias")} end; load("ErlScriptTimeout " ++ Timeout, [])-> case catch list_to_integer(string:strip(Timeout)) of @@ -224,8 +225,8 @@ match_esi_script(_, [], _) -> no_match; match_esi_script(RequestURI, [{Alias,Modules} | Rest], AliasType) -> AliasMatchStr = alias_match_str(Alias, AliasType), - case inets_regexp:first_match(RequestURI, AliasMatchStr) of - {match, 1, Length} -> + case re:run(RequestURI, AliasMatchStr, [{capture, first}]) of + {match, [{0, Length}]} -> {string:substr(RequestURI, Length + 1), Modules}; nomatch -> match_esi_script(RequestURI, Rest, AliasType) @@ -281,6 +282,15 @@ erl(#mod{request_uri = ReqUri, ?NICE("Erl mechanism doesn't support method DELETE")}}| Data]}; +erl(#mod{request_uri = ReqUri, + method = "PATCH", + http_version = Version, + data = Data}, _ESIBody, _Modules) -> + ?hdrt("erl", [{method, patch}]), + {proceed, [{status,{501,{"PATCH", ReqUri, Version}, + ?NICE("Erl mechanism doesn't support method PATCH")}}| + Data]}; + erl(#mod{method = "POST", entity_body = Body} = ModData, ESIBody, Modules) -> ?hdrt("erl", [{method, post}]), @@ -584,9 +594,9 @@ generate_webpage(ESIBody) -> is_authorized(_ESIBody, [all]) -> true; is_authorized(ESIBody, Modules) -> - case inets_regexp:match(ESIBody, "^[^\:(%3A)]*") of - {match, Start, Length} -> - lists:member(list_to_atom(string:substr(ESIBody, Start, Length)), + case re:run(ESIBody, "^[^\:(%3A)]*", [{capture, first}]) of + {match, [{Start, Length}]} -> + lists:member(list_to_atom(string:substr(ESIBody, Start+1, Length)), Modules); nomatch -> false diff --git a/lib/inets/src/http_server/mod_htaccess.erl b/lib/inets/src/http_server/mod_htaccess.erl index c6ae20ced7..f229c96f2d 100644 --- a/lib/inets/src/http_server/mod_htaccess.erl +++ b/lib/inets/src/http_server/mod_htaccess.erl @@ -327,9 +327,9 @@ memberNetwork(Networks,UserNetwork,IfTrue,IfFalse)-> %ipadresses or subnet addresses. memberNetwork(Networks,UserNetwork)-> case lists:filter(fun(Net)-> - case inets_regexp:match(UserNetwork, - formatRegexp(Net)) of - {match,1,_}-> + case re:run(UserNetwork, + formatRegexp(Net), [{capture, first}]) of + {match,[{0,_}]}-> true; _NotSubNet -> false @@ -638,13 +638,8 @@ getHtAccessFileNames(Info)-> %HtAccessFileNames=["accessfileName1",..."AccessFileName2"] %---------------------------------------------------------------------- getData(Path,Info,HtAccessFileNames)-> - case inets_regexp:split(Path,"/") of - {error,Error}-> - {error,Error}; - {ok,SplittedPath}-> - getData2(HtAccessFileNames,SplittedPath,Info) - end. - + SplittedPath = re:split(Path, "/", [{return, list}]), + getData2(HtAccessFileNames,SplittedPath,Info). %---------------------------------------------------------------------- %Add to together the data in the Splittedpath up to the path @@ -942,20 +937,16 @@ getAuthorizationType(AuthType)-> %Returns a list of the specified methods to limit or the atom all %---------------------------------------------------------------------- getLimits(Limits)-> - case inets_regexp:split(Limits,">")of - {ok,[_NoEndOnLimit]}-> + case re:split(Limits,">", [{return, list}])of + [_NoEndOnLimit]-> error; - {ok, [Methods | _Crap]}-> - case inets_regexp:split(Methods," ") of - {ok,[]}-> + [Methods | _Crap]-> + case re:split(Methods," ", [{return, list}]) of + [[]]-> all; - {ok,SplittedMethods}-> - SplittedMethods; - {error, _Error}-> - error - end; - {error,_Error}-> - error + SplittedMethods -> + SplittedMethods + end end. diff --git a/lib/inets/src/http_server/mod_security.erl b/lib/inets/src/http_server/mod_security.erl index 20f87619c1..1f936d598a 100644 --- a/lib/inets/src/http_server/mod_security.erl +++ b/lib/inets/src/http_server/mod_security.erl @@ -273,12 +273,12 @@ secret_path(_Path, [], to_be_found) -> secret_path(_Path, [], Dir) -> {yes, Dir}; secret_path(Path, [[NewDir]|Rest], Dir) -> - case inets_regexp:match(Path, NewDir) of - {match, _, _} when Dir =:= to_be_found -> + case re:run(Path, NewDir, [{capture, first}]) of + {match, _} when Dir =:= to_be_found -> secret_path(Path, Rest, NewDir); - {match, _, Length} when Length > length(Dir) -> + {match, [{_, Length}]} when Length > length(Dir) -> secret_path(Path, Rest, NewDir); - {match, _, _} -> + {match, _} -> secret_path(Path, Rest, Dir); nomatch -> secret_path(Path, Rest, Dir) diff --git a/lib/inets/src/inets_app/Makefile b/lib/inets/src/inets_app/Makefile index 82cda6aaf0..0a4b625b6a 100644 --- a/lib/inets/src/inets_app/Makefile +++ b/lib/inets/src/inets_app/Makefile @@ -47,7 +47,6 @@ MODULES = \ inets_service \ inets_app \ inets_sup \ - inets_regexp \ inets_trace \ inets_lib \ inets_time_compat diff --git a/lib/inets/src/inets_app/inets.app.src b/lib/inets/src/inets_app/inets.app.src index 883ba84e8e..2f213794a3 100644 --- a/lib/inets/src/inets_app/inets.app.src +++ b/lib/inets/src/inets_app/inets.app.src @@ -26,7 +26,6 @@ inets_sup, inets_app, inets_service, - inets_regexp, inets_trace, inets_lib, inets_time_compat, diff --git a/lib/inets/src/inets_app/inets_regexp.erl b/lib/inets/src/inets_app/inets_regexp.erl deleted file mode 100644 index fc1608bc5a..0000000000 --- a/lib/inets/src/inets_app/inets_regexp.erl +++ /dev/null @@ -1,414 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2009. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - --module(inets_regexp). - --export([parse/1, match/2, first_match/2, split/2, sub/3, gsub/3]). - - -%%%========================================================================= -%%% API -%%%========================================================================= - -%% parse(RegExp) -> {ok, RE} | {error, E}. -%% Parse the regexp described in the string RegExp. - -parse(S) -> - case (catch reg(S)) of - {R, []} -> - {ok, R}; - {_R, [C|_]} -> - {error, {illegal, [C]}}; - {error, E} -> - {error, E} - end. - - -%% Find the longest match of RegExp in String. - -match(S, RegExp) when is_list(RegExp) -> - case parse(RegExp) of - {ok,RE} -> match(S, RE); - {error,E} -> {error,E} - end; -match(S, RE) -> - case match(RE, S, 1, 0, -1) of - {Start,Len} when Len >= 0 -> - {match, Start, Len}; - {_Start,_Len} -> - nomatch - end. - -%% Find the first match of RegExp in String. - -first_match(S, RegExp) when is_list(RegExp) -> - case parse(RegExp) of - {ok, RE} -> - first_match(S, RE); - {error, E} -> - {error, E} - end; -first_match(S, RE) -> - case first_match(RE, S, 1) of - {Start,Len} when Len >= 0 -> - {match, Start,Len}; - nomatch -> - nomatch - end. - -first_match(RE, S, St) when S =/= [] -> - case re_apply(S, St, RE) of - {match, P, _Rest} -> - {St, P-St}; - nomatch -> - first_match(RE, tl(S), St+1) - end; -first_match(_RE, [], _St) -> - nomatch. - - -match(RE, S, St, Pos, L) -> - case first_match(RE, S, St) of - {St1, L1} -> - Nst = St1 + 1, - if L1 > L -> - match(RE, lists:nthtail(Nst-St, S), Nst, St1, L1); - true -> - match(RE, lists:nthtail(Nst-St, S), Nst, Pos, L) - end; - nomatch -> - {Pos, L} - end. - - -%% Split a string into substrings where the RegExp describes the -%% field seperator. The RegExp " " is specially treated. - -split(String, " ") -> %This is really special - {ok, RE} = parse("[ \t]+"), - case split_apply(String, RE, true) of - [[]|Ss] -> - {ok,Ss}; - Ss -> - {ok,Ss} - end; -split(String, RegExp) when is_list(RegExp) -> - case parse(RegExp) of - {ok, RE} -> - {ok, split_apply(String, RE, false)}; - {error, E} -> - {error,E} - end; -split(String, RE) -> - {ok, split_apply(String, RE, false)}. - - -%% Substitute the first match of the regular expression RegExp -%% with the string Replace in String. Accept pre-parsed regular -%% expressions. - -sub(String, RegExp, Rep) when is_list(RegExp) -> - case parse(RegExp) of - {ok, RE} -> - sub(String, RE, Rep); - {error, E} -> - {error, E} - end; -sub(String, RE, Rep) -> - Ss = sub_match(String, RE, 1), - {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}. - - -%% Substitute every match of the regular expression RegExp with -%% the string New in String. Accept pre-parsed regular expressions. - -gsub(String, RegExp, Rep) when is_list(RegExp) -> - case parse(RegExp) of - {ok, RE} -> - gsub(String, RE, Rep); - {error, E} -> - {error, E} - end; -gsub(String, RE, Rep) -> - Ss = matches(String, RE, 1), - {ok, sub_repl(Ss, Rep, String, 1), length(Ss)}. - - -%%%======================================================================== -%%% Internal functions -%%%======================================================================== - -%% This is the regular expression grammar used. It is equivalent to the -%% one used in AWK, except that we allow ^ $ to be used anywhere and fail -%% in the matching. -%% -%% reg -> reg1 : '$1'. -%% reg1 -> reg1 "|" reg2 : {'or','$1','$2'}. -%% reg1 -> reg2 : '$1'. -%% reg2 -> reg2 reg3 : {concat,'$1','$2'}. -%% reg2 -> reg3 : '$1'. -%% reg3 -> reg3 "*" : {kclosure,'$1'}. -%% reg3 -> reg3 "+" : {pclosure,'$1'}. -%% reg3 -> reg3 "?" : {optional,'$1'}. -%% reg3 -> reg4 : '$1'. -%% reg4 -> "(" reg ")" : '$2'. -%% reg4 -> "\\" char : '$2'. -%% reg4 -> "^" : bos. -%% reg4 -> "$" : eos. -%% reg4 -> "." : char. -%% reg4 -> "[" class "]" : {char_class,char_class('$2')} -%% reg4 -> "[" "^" class "]" : {comp_class,char_class('$3')} -%% reg4 -> "\"" chars "\"" : char_string('$2') -%% reg4 -> char : '$1'. -%% reg4 -> empty : epsilon. -%% The grammar of the current regular expressions. The actual parser -%% is a recursive descent implementation of the grammar. - -reg(S) -> reg1(S). - -%% reg1 -> reg2 reg1' -%% reg1' -> "|" reg2 -%% reg1' -> empty - -reg1(S0) -> - {L,S1} = reg2(S0), - reg1p(S1, L). - -reg1p([$||S0], L) -> - {R,S1} = reg2(S0), - reg1p(S1, {'or',L,R}); -reg1p(S, L) -> {L,S}. - -%% reg2 -> reg3 reg2' -%% reg2' -> reg3 -%% reg2' -> empty - -reg2(S0) -> - {L,S1} = reg3(S0), - reg2p(S1, L). - -reg2p([C|S0], L) when (C =/= $|) andalso (C =/= $)) -> - {R,S1} = reg3([C|S0]), - reg2p(S1, {concat,L,R}); -reg2p(S, L) -> {L,S}. - -%% reg3 -> reg4 reg3' -%% reg3' -> "*" reg3' -%% reg3' -> "+" reg3' -%% reg3' -> "?" reg3' -%% reg3' -> empty - -reg3(S0) -> - {L,S1} = reg4(S0), - reg3p(S1, L). - -reg3p([$*|S], L) -> reg3p(S, {kclosure,L}); -reg3p([$+|S], L) -> reg3p(S, {pclosure,L}); -reg3p([$?|S], L) -> reg3p(S, {optional,L}); -reg3p(S, L) -> {L,S}. - -reg4([$(|S0]) -> - case reg(S0) of - {R,[$)|S1]} -> {R,S1}; - {_R,_S} -> throw({error,{unterminated,"("}}) - end; -reg4([$\\,O1,O2,O3|S]) - when ((O1 >= $0) andalso - (O1 =< $7) andalso - (O2 >= $0) andalso - (O2 =< $7) andalso - (O3 >= $0) andalso - (O3 =< $7)) -> - {(O1*8 + O2)*8 + O3 - 73*$0,S}; -reg4([$\\,C|S]) -> - {escape_char(C),S}; -reg4([$\\]) -> - throw({error, {unterminated,"\\"}}); -reg4([$^|S]) -> - {bos,S}; -reg4([$$|S]) -> - {eos,S}; -reg4([$.|S]) -> - {{comp_class,"\n"},S}; -reg4("[^" ++ S0) -> - case char_class(S0) of - {Cc,[$]|S1]} -> {{comp_class,Cc},S1}; - {_Cc,_S} -> throw({error,{unterminated,"["}}) - end; -reg4([$[|S0]) -> - case char_class(S0) of - {Cc,[$]|S1]} -> {{char_class,Cc},S1}; - {_Cc,_S1} -> throw({error,{unterminated,"["}}) - end; -reg4([C|S]) - when (C =/= $*) andalso (C =/= $+) andalso (C =/= $?) andalso (C =/= $]) -> - {C, S}; -reg4([C|_S]) -> - throw({error,{illegal,[C]}}); -reg4([]) -> - {epsilon,[]}. - -escape_char($n) -> $\n; %\n = LF -escape_char($r) -> $\r; %\r = CR -escape_char($t) -> $\t; %\t = TAB -escape_char($v) -> $\v; %\v = VT -escape_char($b) -> $\b; %\b = BS -escape_char($f) -> $\f; %\f = FF -escape_char($e) -> $\e; %\e = ESC -escape_char($s) -> $\s; %\s = SPACE -escape_char($d) -> $\d; %\d = DEL -escape_char(C) -> C. - -char_class([$]|S]) -> char_class(S, [$]]); -char_class(S) -> char_class(S, []). - -char($\\, [O1,O2,O3|S]) when - O1 >= $0, O1 =< $7, O2 >= $0, O2 =< $7, O3 >= $0, O3 =< $7 -> - {(O1*8 + O2)*8 + O3 - 73*$0,S}; -char($\\, [C|S]) -> {escape_char(C),S}; -char(C, S) -> {C,S}. - -char_class([C1|S0], Cc) when C1 =/= $] -> - case char(C1, S0) of - {Cf,[$-,C2|S1]} when C2 =/= $] -> - case char(C2, S1) of - {Cl,S2} when Cf < Cl -> char_class(S2, [{Cf,Cl}|Cc]); - {Cl,_S2} -> throw({error,{char_class,[Cf,$-,Cl]}}) - end; - {C,S1} -> char_class(S1, [C|Cc]) - end; -char_class(S, Cc) -> {Cc,S}. - - -%% re_apply(String, StartPos, RegExp) -> re_app_res(). -%% -%% Apply the (parse of the) regular expression RegExp to String. If -%% there is a match return the position of the remaining string and -%% the string if else return 'nomatch'. BestMatch specifies if we want -%% the longest match, or just a match. -%% -%% StartPos should be the real start position as it is used to decide -%% if we ae at the beginning of the string. -%% -%% Pass two functions to re_apply_or so it can decide, on the basis -%% of BestMatch, whether to just any take any match or try both to -%% find the longest. This is slower but saves duplicatng code. - -re_apply(S, St, RE) -> re_apply(RE, [], S, St). - -re_apply(epsilon, More, S, P) -> %This always matches - re_apply_more(More, S, P); -re_apply({'or',RE1,RE2}, More, S, P) -> - re_apply_or(re_apply(RE1, More, S, P), - re_apply(RE2, More, S, P)); -re_apply({concat,RE1,RE2}, More, S0, P) -> - re_apply(RE1, [RE2|More], S0, P); -re_apply({kclosure,CE}, More, S, P) -> - %% Be careful with the recursion, explicitly do one call before - %% looping. - re_apply_or(re_apply_more(More, S, P), - re_apply(CE, [{kclosure,CE}|More], S, P)); -re_apply({pclosure,CE}, More, S, P) -> - re_apply(CE, [{kclosure,CE}|More], S, P); -re_apply({optional,CE}, More, S, P) -> - re_apply_or(re_apply_more(More, S, P), - re_apply(CE, More, S, P)); -re_apply(bos, More, S, 1) -> re_apply_more(More, S, 1); -re_apply(eos, More, [$\n|S], P) -> re_apply_more(More, S, P); -re_apply(eos, More, [], P) -> re_apply_more(More, [], P); -re_apply({char_class,Cc}, More, [C|S], P) -> - case in_char_class(C, Cc) of - true -> re_apply_more(More, S, P+1); - false -> nomatch - end; -re_apply({comp_class,Cc}, More, [C|S], P) -> - case in_char_class(C, Cc) of - true -> nomatch; - false -> re_apply_more(More, S, P+1) - end; -re_apply(C, More, [C|S], P) when is_integer(C) -> - re_apply_more(More, S, P+1); -re_apply(_RE, _More, _S, _P) -> nomatch. - -%% re_apply_more([RegExp], String, Length) -> re_app_res(). - -re_apply_more([RE|More], S, P) -> re_apply(RE, More, S, P); -re_apply_more([], S, P) -> {match,P,S}. - -%% in_char_class(Char, Class) -> bool(). - -in_char_class(C, [{C1,C2}|_Cc]) when C >= C1, C =< C2 -> true; -in_char_class(C, [C|_Cc]) -> true; -in_char_class(C, [_|Cc]) -> in_char_class(C, Cc); -in_char_class(_C, []) -> false. - -%% re_apply_or(Match1, Match2) -> re_app_res(). -%% If we want the best match then choose the longest match, else just -%% choose one by trying sequentially. - -re_apply_or({match,P1,S1}, {match,P2,_S2}) when P1 >= P2 -> {match,P1,S1}; -re_apply_or({match,_P1,_S1}, {match,P2,S2}) -> {match,P2,S2}; -re_apply_or(nomatch, R2) -> R2; -re_apply_or(R1, nomatch) -> R1. - - -matches(S, RE, St) -> - case first_match(RE, S, St) of - {St1,0} -> - [{St1,0}|matches(string:substr(S, St1+2-St), RE, St1+1)]; - {St1,L1} -> - [{St1,L1}|matches(string:substr(S, St1+L1+1-St), RE, St1+L1)]; - nomatch -> - [] - end. - -sub_match(S, RE, St) -> - case first_match(RE, S, St) of - {St1,L1} -> [{St1,L1}]; - nomatch -> [] - end. - -sub_repl([{St,L}|Ss], Rep, S, Pos) -> - Rs = sub_repl(Ss, Rep, S, St+L), - string:substr(S, Pos, St-Pos) ++ - sub_repl(Rep, string:substr(S, St, L), Rs); -sub_repl([], _Rep, S, Pos) -> - string:substr(S, Pos). - -sub_repl([$&|Rep], M, Rest) -> M ++ sub_repl(Rep, M, Rest); -sub_repl("\\&" ++ Rep, M, Rest) -> [$&|sub_repl(Rep, M, Rest)]; -sub_repl([C|Rep], M, Rest) -> [C|sub_repl(Rep, M, Rest)]; -sub_repl([], _M, Rest) -> Rest. - -split_apply(S, RE, Trim) -> split_apply(S, 1, RE, Trim, []). - -split_apply([], _P, _RE, true, []) -> - []; -split_apply([], _P, _RE, _T, Sub) -> - [lists:reverse(Sub)]; -split_apply(S, P, RE, T, Sub) -> - case re_apply(S, P, RE) of - {match,P,_Rest} -> - split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]); - {match,P1,Rest} -> - [lists:reverse(Sub)|split_apply(Rest, P1, RE, T, [])]; - nomatch -> - split_apply(tl(S), P+1, RE, T, [hd(S)|Sub]) - end. diff --git a/lib/inets/src/tftp/tftp_engine.erl b/lib/inets/src/tftp/tftp_engine.erl index d0510e795b..8d282a1e9d 100644 --- a/lib/inets/src/tftp/tftp_engine.erl +++ b/lib/inets/src/tftp/tftp_engine.erl @@ -1153,8 +1153,8 @@ match_callback(Filename, Callbacks) -> end. do_match_callback(Filename, [C | Tail]) when is_record(C, callback) -> - case catch inets_regexp:match(Filename, C#callback.internal) of - {match, _, _} -> + case catch re:run(Filename, C#callback.internal, [{capture, none}]) of + match -> {ok, C}; nomatch -> do_match_callback(Filename, Tail); diff --git a/lib/inets/src/tftp/tftp_lib.erl b/lib/inets/src/tftp/tftp_lib.erl index 71327f8023..01dea97d07 100644 --- a/lib/inets/src/tftp/tftp_lib.erl +++ b/lib/inets/src/tftp/tftp_lib.erl @@ -184,7 +184,7 @@ do_parse_config([{Key, Val} | Tail], Config) when is_record(Config, config) -> callback -> case Val of {RegExp, Mod, State} when is_list(RegExp), is_atom(Mod) -> - case inets_regexp:parse(RegExp) of + case re:compile(RegExp) of {ok, Internal} -> Callback = #callback{regexp = RegExp, internal = Internal, @@ -253,7 +253,7 @@ do_parse_config(Options, Config) when is_record(Config, config) -> add_default_callbacks(Callbacks) -> RegExp = "", - {ok, Internal} = inets_regexp:parse(RegExp), + {ok, Internal} = re:compile(RegExp), File = #callback{regexp = RegExp, internal = Internal, module = tftp_file, diff --git a/lib/inets/test/httpc_SUITE.erl b/lib/inets/test/httpc_SUITE.erl index c6c59ab1af..93b96e101f 100644 --- a/lib/inets/test/httpc_SUITE.erl +++ b/lib/inets/test/httpc_SUITE.erl @@ -68,6 +68,7 @@ real_requests()-> get, post, post_stream, + patch, async, pipeline, persistent_connection, @@ -257,6 +258,28 @@ post(Config) when is_list(Config) -> "text/plain", "foobar"}, [], []). %%-------------------------------------------------------------------- +patch() -> + [{"Test http patch request against local server. We do in this case " + "only care about the client side of the the patch. The server " + "script will not actually use the patch data."}]. +patch(Config) when is_list(Config) -> + CGI = case test_server:os_type() of + {win32, _} -> + "/cgi-bin/cgi_echo.exe"; + _ -> + "/cgi-bin/cgi_echo" + end, + + URL = url(group_name(Config), CGI, Config), + + %% Cgi-script expects the body length to be 100 + Body = lists:duplicate(100, "1"), + + {ok, {{_,200,_}, [_ | _], [_ | _]}} = + httpc:request(patch, {URL, [{"expect","100-continue"}], + "text/plain", Body}, [], []). + +%%-------------------------------------------------------------------- post_stream() -> [{"Test streaming http post request against local server. " "We only care about the client side of the the post. " diff --git a/lib/inets/test/httpd_1_1.erl b/lib/inets/test/httpd_1_1.erl index db6def9d17..d3a1e3672a 100644 --- a/lib/inets/test/httpd_1_1.erl +++ b/lib/inets/test/httpd_1_1.erl @@ -370,18 +370,18 @@ validateRangeRequest2(Socket, Head, Body, ValidBody, BodySize) validateMultiPartRangeRequest(Body, ValidBody, Boundary)-> - case inets_regexp:split(Body,"--"++Boundary++"--") of + case re:split(Body,"--"++Boundary++"--", [{return, list}]) of %%Last is the epilogue and must be ignored - {ok,[First | _Last]}-> + [First | _Last]-> %%First is now the actuall http request body. - case inets_regexp:split(First, "--" ++ Boundary) of + case re:split(First, "--" ++ Boundary, [{return, list}]) of %%Parts is now a list of ranges and the heads for each range %%Gues we try to split out the body - {ok,Parts}-> + Parts-> case lists:flatten(lists:map(fun splitRange/1,Parts)) of ValidBody-> ok; - ParsedBody-> + ParsedBody-> error = ParsedBody end end; @@ -391,8 +391,8 @@ validateMultiPartRangeRequest(Body, ValidBody, Boundary)-> splitRange(Part)-> - case inets_regexp:split(Part, "\r\n\r\n") of - {ok,[_, Body]} -> + case re:split(Part, "\r\n\r\n", [{return, list}]) of + [_, Body] -> string:substr(Body, 1, length(Body) - 2); _ -> [] @@ -412,13 +412,13 @@ getRangeSize(Head)-> {multiPart, BoundaryString}-> {multiPart, BoundaryString}; _X1 -> - case inets_regexp:match(Head, ?CONTENT_RANGE "bytes=.*\r\n") of - {match, Start, Lenght} -> + case re:run(Head, ?CONTENT_RANGE "bytes=.*\r\n", [{capture, first}]) of + {match, [{Start, Lenght}]} -> %% Get the range data remove the fieldname and the %% end of line. - RangeInfo = string:substr(Head, Start + 20, - Lenght - (20 - 2)), - rangeSize(RangeInfo); + RangeInfo = string:substr(Head, Start + 1 + 20, + Lenght - (20 +2)), + rangeSize(string:strip(RangeInfo)); _X2 -> error end @@ -454,10 +454,10 @@ num(_CharVal, false) -> true. controlMimeType(Head)-> - case inets_regexp:match(Head,?CONTENT_TYPE "multipart/byteranges.*\r\n") of - {match,Start,Length}-> + case re:run(Head,?CONTENT_TYPE "multipart/byteranges.*\r\n", [{capture, first}]) of + {match, [{Start,Length}]}-> FieldNameLen = length(?CONTENT_TYPE "multipart/byteranges"), - case clearBoundary(string:substr(Head, Start + FieldNameLen, + case clearBoundary(string:substr(Head, Start + 1 + FieldNameLen, Length - (FieldNameLen+2))) of error -> error; @@ -471,10 +471,10 @@ controlMimeType(Head)-> end. clearBoundary(Boundary)-> - case inets_regexp:match(Boundary, "boundary=.*\$") of - {match, Start1, Length1}-> + case re:run(Boundary, "boundary=.*\$", [{capture, first}]) of + {match, [{Start1, Length1}]}-> BoundLen = length("boundary="), - string:substr(Boundary, Start1 + BoundLen, Length1 - BoundLen); + string:substr(Boundary, Start1 + 1 + BoundLen, Length1 - BoundLen); _ -> error end. @@ -489,12 +489,12 @@ end_of_header(HeaderPart) -> end. get_body_size(Head) -> - case inets_regexp:match(Head,?CONTENT_LENGTH ".*\r\n") of - {match, Start, Length} -> + case re:run(Head,?CONTENT_LENGTH ".*\r\n", [{capture, first}]) of + {match, [{Start, Length}]} -> %% 15 is length of Content-Length, %% 17 Is length of Content-Length and \r\ S = list_to_integer( - string:strip(string:substr(Head, Start + 15, Length-17))), + string:strip(string:substr(Head, Start +1 + 15, Length-17))), S; _-> 0 diff --git a/lib/inets/test/httpd_poll.erl b/lib/inets/test/httpd_poll.erl index aca7b70376..4a570fb512 100644 --- a/lib/inets/test/httpd_poll.erl +++ b/lib/inets/test/httpd_poll.erl @@ -259,11 +259,11 @@ validate(ExpStatusCode,Socket,Response) -> vtrace("validate -> Entry with ~p bytes response",[Sz]), Size = trash_the_rest(Socket,Sz), close(Socket), - case inets_regexp:split(Response," ") of - {ok,["HTTP/1.0",ExpStatusCode|_]} -> + case re:split(Response," ", [{return, list}]) of + ["HTTP/1.0",ExpStatusCode|_] -> vlog("response (~p bytes) was ok",[Size]), ok; - {ok,["HTTP/1.0",StatusCode|_]} -> + ["HTTP/1.0",StatusCode|_] -> verror("unexpected response status received: ~s => ~s", [StatusCode,status_to_message(StatusCode)]), log("unexpected result to GET of '~s': ~s => ~s", diff --git a/lib/inets/test/httpd_test_lib.erl b/lib/inets/test/httpd_test_lib.erl index c58966ce10..71e201f826 100644 --- a/lib/inets/test/httpd_test_lib.erl +++ b/lib/inets/test/httpd_test_lib.erl @@ -96,10 +96,10 @@ verify_request(SocketType, Host, Port, TranspOpts, Node, RequestStr, Options, Ti try inets_test_lib:connect_bin(SocketType, Host, Port, TranspOpts) of {ok, Socket} -> ok = inets_test_lib:send(SocketType, Socket, RequestStr), - State = case inets_regexp:match(RequestStr, "printenv") of + State = case re:run(RequestStr, "printenv", [{capture, none}]) of nomatch -> #state{}; - _ -> + match -> #state{print = true} end, @@ -317,10 +317,10 @@ do_validate(Header, [_Unknown | Rest], N, P) -> do_validate(Header, Rest, N, P). is_expect(RequestStr) -> - case inets_regexp:match(RequestStr, "xpect:100-continue") of - {match, _, _}-> + case re:run(RequestStr, "xpect:100-continue", [{capture, none}]) of + match-> true; - _ -> + nomatch -> false end. diff --git a/lib/inets/test/httpd_time_test.erl b/lib/inets/test/httpd_time_test.erl index 7c0acb5a99..1b4d74b28e 100644 --- a/lib/inets/test/httpd_time_test.erl +++ b/lib/inets/test/httpd_time_test.erl @@ -386,31 +386,31 @@ validate(ExpStatusCode, _SocketType, _Socket, Response) -> %% Sz = sz(Response), %% trash_the_rest(Socket, Sz), %% inets_test_lib:close(SocketType, Socket), - case inets_regexp:split(Response," ") of - {ok, ["HTTP/1.0", ExpStatusCode|_]} -> + case re:split(Response," ", [{return, list}]) of + ["HTTP/1.0", ExpStatusCode|_] -> ok; - {ok, ["HTTP/1.0", StatusCode|_]} -> + ["HTTP/1.0", StatusCode|_] -> error_msg("Unexpected status code: ~p (~s). " "Expected status code: ~p (~s)", [StatusCode, status_to_message(StatusCode), ExpStatusCode, status_to_message(ExpStatusCode)]), exit({unexpected_response_code, StatusCode, ExpStatusCode}); - {ok, ["HTTP/1.1", ExpStatusCode|_]} -> + ["HTTP/1.1", ExpStatusCode|_] -> ok; - {ok, ["HTTP/1.1", StatusCode|_]} -> + ["HTTP/1.1", StatusCode|_] -> error_msg("Unexpected status code: ~p (~s). " "Expected status code: ~p (~s)", [StatusCode, status_to_message(StatusCode), ExpStatusCode, status_to_message(ExpStatusCode)]), exit({unexpected_response_code, StatusCode, ExpStatusCode}); - {ok, Unexpected} -> - error_msg("Unexpected response split: ~p (~s)", - [Unexpected, Response]), - exit({unexpected_response, Unexpected, Response}); - {error, Reason} -> + {error, Reason} -> error_msg("Failed processing response: ~p (~s)", [Reason, Response]), - exit({failed_response_processing, Reason, Response}) + exit({failed_response_processing, Reason, Response}); + Unexpected -> + error_msg("Unexpected response split: ~p (~s)", + [Unexpected, Response]), + exit({unexpected_response, Unexpected, Response}) end. diff --git a/lib/inets/vsn.mk b/lib/inets/vsn.mk index 2717f5b110..ee5f41aaec 100644 --- a/lib/inets/vsn.mk +++ b/lib/inets/vsn.mk @@ -19,6 +19,6 @@ # %CopyrightEnd% APPLICATION = inets -INETS_VSN = 6.1 +INETS_VSN = 6.1.1 PRE_VSN = APP_VSN = "$(APPLICATION)-$(INETS_VSN)$(PRE_VSN)" diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml index eb0f4b7a06..1bd52040a0 100644 --- a/lib/kernel/doc/src/code.xml +++ b/lib/kernel/doc/src/code.xml @@ -287,6 +287,46 @@ was given to <c>set_path/1</c>).</p> </section> + <section> + <marker id="error_reasons"></marker> + <title>Error Reasons for Code-Loading Functions</title> + + <p>Functions that load code (such as <c>load_file/1</c>) will + return <c>{error,Reason}</c> if the load operation fails. + Here follows a description of the common reasons.</p> + + <taglist> + <tag><c>badfile</c></tag> + <item> + <p>The object code has an incorrect format or the module + name in the object code is not the expected module name.</p> + </item> + + <tag><c>nofile</c></tag> + <item> + <p>No file with object code was found.</p> + </item> + + <tag><c>not_purged</c></tag> + <item> + <p>The object code could not be loaded because an old version + of the code already existed.</p> + </item> + + <tag><c>on_load_failure</c></tag> + <item> + <p>The module has an + <seealso marker="doc/reference_manual:code_loading#on_load">-on_load function</seealso> + that failed when it was called.</p> + </item> + + <tag><c>sticky_directory</c></tag> + <item> + <p>The object code resides in a sticky directory.</p> + </item> + + </taglist> + </section> <datatypes> <datatype> <name name="load_ret"/> @@ -411,12 +451,8 @@ be used to load object code with a module name that is different from the file name.</p> <p>Returns <c>{module, <anno>Module</anno>}</c> if successful, or - <c>{error, nofile}</c> if no object code is found, or - <c>{error, sticky_directory}</c> if the object code resides in - a sticky directory. Also if the loading fails, an error tuple is - returned. See - <seealso marker="erts:erlang#load_module/2">erlang:load_module/2</seealso> - for possible values of <c><anno>What</anno></c>.</p> + <c>{error, Reason}</c> if loading fails. + See <seealso marker="#error_reasons">Error Reasons for Code-Loading Functions</seealso> for a description of the possible error reasons.</p> </desc> </func> <func> @@ -428,7 +464,7 @@ <desc> <p>Does the same as <c>load_file(<anno>Module</anno>)</c>, but <c><anno>Filename</anno></c> is either an absolute file name, or a - relative file name. The code path is not searched. It returns + relative file name. The code path is not searched. It returns a value in the same way as <seealso marker="#load_file/1">load_file/1</seealso>. Note that <c><anno>Filename</anno></c> should not contain the extension (for @@ -444,7 +480,8 @@ <seealso marker="#load_file/1">load_file/1</seealso>, unless the module is already loaded. In embedded mode, however, it does not load a module which is not - already loaded, but returns <c>{error, embedded}</c> instead.</p> + already loaded, but returns <c>{error, embedded}</c> instead. + See <seealso marker="#error_reasons">Error Reasons for Code-Loading Functions</seealso> for a description of other possible error reasons.</p> </desc> </func> <func> @@ -461,12 +498,8 @@ comes. Accordingly, <c><anno>Filename</anno></c> is not opened and read by the code server.</p> <p>Returns <c>{module, <anno>Module</anno>}</c> if successful, or - <c>{error, sticky_directory}</c> if the object code resides in - a sticky directory, or <c>{error, badarg}</c> if any argument - is invalid. Also if the loading fails, an error tuple is - returned. See - <seealso marker="erts:erlang#load_module/2">erlang:load_module/2</seealso> - for possible values of <c><anno>What</anno></c>.</p> + <c>{error, Reason}</c> if loading fails. + See <seealso marker="#error_reasons">Error Reasons for Code-Loading Functions</seealso> for a description of the possible error reasons.</p> </desc> </func> <func> diff --git a/lib/kernel/doc/src/net_kernel.xml b/lib/kernel/doc/src/net_kernel.xml index a0132db8db..311e0d8ea4 100644 --- a/lib/kernel/doc/src/net_kernel.xml +++ b/lib/kernel/doc/src/net_kernel.xml @@ -63,11 +63,16 @@ <funcs> <func> <name name="allow" arity="1"/> - <fsummary>Limit access to a specified set of nodes</fsummary> + <fsummary>Permit access to a specified set of nodes</fsummary> <desc> - <p>Limits access to the specified set of nodes. Any access - attempts made from (or to) nodes not in <c><anno>Nodes</anno></c> will be - rejected.</p> + <p>Permits access to the specified set of nodes.</p> + <p>Before the first call to <c>allow/1</c>, any node with the correct + cookie can be connected. When <c>allow/1</c> is called, a list + of allowed nodes is established. Any access attempts made from (or to) + nodes not in that list will be rejected.</p> + <p>Subsequent calls to <c>allow/1</c> will add the specified nodes + to the list of allowed nodes. It is not possible to remove nodes + from the list.</p> <p>Returns <c>error</c> if any element in <c><anno>Nodes</anno></c> is not an atom.</p> </desc> diff --git a/lib/kernel/doc/src/seq_trace.xml b/lib/kernel/doc/src/seq_trace.xml index 3439111035..f4fcd222ec 100644 --- a/lib/kernel/doc/src/seq_trace.xml +++ b/lib/kernel/doc/src/seq_trace.xml @@ -127,6 +127,35 @@ seq_trace:set_token(OldToken), % activate the trace token again enables/disables a timestamp to be generated for each traced event. Default is <c>false</c>.</p> </item> + <tag><c>set_token(strict_monotonic_timestamp, <anno>Bool</anno>)</c></tag> + <item> + <p>A trace token flag (<c>true | false</c>) which + enables/disables a strict monotonic timestamp to be generated + for each traced event. Default is <c>false</c>. Timestamps will + consist of + <seealso marker="erts:time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso> and a monotonically increasing + integer. The time-stamp has the same format and value + as produced by <c>{erlang:monotonic_time(nano_seconds), + erlang:unique_integer([monotonic])}</c>.</p> + </item> + <tag><c>set_token(monotonic_timestamp, <anno>Bool</anno>)</c></tag> + <item> + <p>A trace token flag (<c>true | false</c>) which + enables/disables a strict monotonic timestamp to be generated + for each traced event. Default is <c>false</c>. Timestamps + will use + <seealso marker="erts:time_correction#Erlang_Monotonic_Time">Erlang + monotonic time</seealso>. The time-stamp has the same + format and value as produced by + <c>erlang:monotonic_time(nano_seconds)</c>.</p> + </item> + <p>If multiple timestamp flags are passed, <c>timestamp</c> has + precedence over <c>strict_monotonic_timestamp</c> which + in turn has precedence over <c>monotonic_timestamp</c>. All + timestamp flags are remembered, so if two are passed + and the one with highest precedence later is disabled + the other one will become active.</p> </taglist> </desc> </func> diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl index 352c02562b..7237550786 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -77,10 +77,9 @@ %%---------------------------------------------------------------------------- -type load_error_rsn() :: 'badfile' - | 'native_code' | 'nofile' | 'not_purged' - | 'on_load' + | 'on_load_failure' | 'sticky_directory'. -type load_ret() :: {'error', What :: load_error_rsn()} | {'module', Module :: module()}. @@ -135,14 +134,16 @@ load_file(Mod) when is_atom(Mod) -> -spec ensure_loaded(Module) -> {module, Module} | {error, What} when Module :: module(), - What :: embedded | badfile | native_code | nofile | on_load. + What :: embedded | badfile | nofile | on_load_failure. ensure_loaded(Mod) when is_atom(Mod) -> call({ensure_loaded,Mod}). %% XXX File as an atom is allowed only for backwards compatibility. -spec load_abs(Filename) -> load_ret() when Filename :: file:filename(). -load_abs(File) when is_list(File); is_atom(File) -> call({load_abs,File,[]}). +load_abs(File) when is_list(File); is_atom(File) -> + Mod = list_to_atom(filename:basename(File)), + call({load_abs,File,Mod}). %% XXX Filename is also an atom(), e.g. 'cover_compiled' -spec load_abs(Filename :: loaded_filename(), Module :: module()) -> load_ret(). diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index e461c95d19..614219794c 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -313,7 +313,7 @@ handle_call(get_path, {_From,_Tag}, S) -> {reply,S#state.path,S}; %% Messages to load, delete and purge modules/files. -handle_call({load_abs,File,Mod}, Caller, S) -> +handle_call({load_abs,File,Mod}, Caller, S) when is_atom(Mod) -> case modp(File) of false -> {reply,{error,badarg},S}; @@ -1222,15 +1222,10 @@ modp(Atom) when is_atom(Atom) -> true; modp(List) when is_list(List) -> int_list(List); modp(_) -> false. -load_abs(File, Mod0, Caller, St) -> +load_abs(File, Mod, Caller, St) -> Ext = objfile_extension(), FileName0 = lists:concat([File, Ext]), FileName = absname(FileName0), - Mod = if Mod0 =:= [] -> - list_to_atom(filename:basename(FileName0, Ext)); - true -> - Mod0 - end, case erl_prim_loader:get_file(FileName) of {ok,Bin,_} -> try_load_module(FileName, Mod, Bin, Caller, St); diff --git a/lib/kernel/src/disk_log_1.erl b/lib/kernel/src/disk_log_1.erl index 9b9fd086f1..2e61363aa6 100644 --- a/lib/kernel/src/disk_log_1.erl +++ b/lib/kernel/src/disk_log_1.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2013. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -79,6 +79,7 @@ log(FdC, FileName, X) -> logl(X) -> logl(X, [], 0). +-dialyzer({no_improper_lists, logl/3}). logl([X | T], Bs, Size) -> Sz = byte_size(X), BSz = <<Sz:?SIZESZ/unit:8>>, @@ -1142,6 +1143,7 @@ write_index_file(read_write, FName, NewFile, OldFile, OldCnt) -> file_error(FileName, E) end. +-dialyzer({no_improper_lists, to_8_bytes/4}). to_8_bytes(<<N:32,T/binary>>, NT, FileName, Fd) -> to_8_bytes(T, [NT | <<N:64>>], FileName, Fd); to_8_bytes(B, NT, _FileName, _Fd) when byte_size(B) =:= 0 -> @@ -1276,6 +1278,7 @@ ext_split_bins(CurB, MaxB, FirstPos, Bins) -> MaxBs = MaxB - CurB, IsFirst = CurB =:= FirstPos, ext_split_bins(MaxBs, IsFirst, [], Bins, 0, 0). +-dialyzer({no_improper_lists, ext_split_bins/6}). ext_split_bins(MaxBs, IsFirst, First, [X | Last], Bs, N) -> NBs = Bs + byte_size(X), if @@ -1296,6 +1299,7 @@ int_split_bins(CurB, MaxB, FirstPos, Bins) -> MaxBs = MaxB - CurB, IsFirst = CurB =:= FirstPos, int_split_bins(MaxBs, IsFirst, [], Bins, 0, 0). +-dialyzer({no_improper_lists, int_split_bins/6}). int_split_bins(MaxBs, IsFirst, First, [X | Last], Bs, N) -> Sz = byte_size(X), NBs = Bs + Sz + ?HEADERSZ, diff --git a/lib/kernel/src/heart.erl b/lib/kernel/src/heart.erl index 464b6919f1..137fad706f 100644 --- a/lib/kernel/src/heart.erl +++ b/lib/kernel/src/heart.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -265,6 +265,7 @@ do_cycle_port_program(Caller, Parent, Port, Cmd) -> send_heart_beat(Port) -> Port ! {self(), {command, [?HEART_BEAT]}}. %% Set a new HEART_COMMAND. +-dialyzer({no_improper_lists, send_heart_cmd/2}). send_heart_cmd(Port, []) -> Port ! {self(), {command, [?CLEAR_CMD]}}; send_heart_cmd(Port, Cmd) -> diff --git a/lib/kernel/src/inet.erl b/lib/kernel/src/inet.erl index b573112445..c1ae99ea24 100644 --- a/lib/kernel/src/inet.erl +++ b/lib/kernel/src/inet.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2015. All Rights Reserved. +%% Copyright Ericsson AB 1997-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -289,7 +289,7 @@ getifaddrs(Socket) -> -spec getifaddrs() -> {ok, Iflist} | {error, posix()} when Iflist :: [{Ifname,[Ifopt]}], Ifname :: string(), - Ifopt :: {flag,[Flag]} | {addr,Addr} | {netmask,Netmask} + Ifopt :: {flags,[Flag]} | {addr,Addr} | {netmask,Netmask} | {broadaddr,Broadaddr} | {dstaddr,Dstaddr} | {hwaddr,Hwaddr}, Flag :: up | broadcast | loopback | pointtopoint diff --git a/lib/kernel/src/kernel.app.src b/lib/kernel/src/kernel.app.src index b5555ca1a5..419dc0a2fc 100644 --- a/lib/kernel/src/kernel.app.src +++ b/lib/kernel/src/kernel.app.src @@ -116,6 +116,6 @@ {applications, []}, {env, [{error_logger, tty}]}, {mod, {kernel, []}}, - {runtime_dependencies, ["erts-7.0", "stdlib-2.6", "sasl-2.6"]} + {runtime_dependencies, ["erts-7.3", "stdlib-2.6", "sasl-2.6"]} ] }. diff --git a/lib/kernel/src/seq_trace.erl b/lib/kernel/src/seq_trace.erl index 07ccd3e494..a7a782c29c 100644 --- a/lib/kernel/src/seq_trace.erl +++ b/lib/kernel/src/seq_trace.erl @@ -23,7 +23,9 @@ -define(SEQ_TRACE_SEND, 1). %(1 << 0) -define(SEQ_TRACE_RECEIVE, 2). %(1 << 1) -define(SEQ_TRACE_PRINT, 4). %(1 << 2) --define(SEQ_TRACE_TIMESTAMP, 8). %(1 << 3) +-define(SEQ_TRACE_NOW_TIMESTAMP, 8). %(1 << 3) +-define(SEQ_TRACE_STRICT_MON_TIMESTAMP, 16). %(1 << 4) +-define(SEQ_TRACE_MON_TIMESTAMP, 32). %(1 << 5) -export([set_token/1, set_token/2, @@ -37,7 +39,7 @@ %%--------------------------------------------------------------------------- --type flag() :: 'send' | 'receive' | 'print' | 'timestamp'. +-type flag() :: 'send' | 'receive' | 'print' | 'timestamp' | 'monotonic_timestamp' | 'strict_monotonic_timestamp'. -type component() :: 'label' | 'serial' | flag(). -type value() :: (Integer :: non_neg_integer()) | {Previous :: non_neg_integer(), @@ -135,5 +137,9 @@ decode_flags(Flags) -> Print = (Flags band ?SEQ_TRACE_PRINT) > 0, Send = (Flags band ?SEQ_TRACE_SEND) > 0, Rec = (Flags band ?SEQ_TRACE_RECEIVE) > 0, - Ts = (Flags band ?SEQ_TRACE_TIMESTAMP) > 0, - [{print,Print},{send,Send},{'receive',Rec},{timestamp,Ts}]. + NowTs = (Flags band ?SEQ_TRACE_NOW_TIMESTAMP) > 0, + StrictMonTs = (Flags band ?SEQ_TRACE_STRICT_MON_TIMESTAMP) > 0, + MonTs = (Flags band ?SEQ_TRACE_MON_TIMESTAMP) > 0, + [{print,Print},{send,Send},{'receive',Rec},{timestamp,NowTs}, + {strict_monotonic_timestamp, StrictMonTs}, + {monotonic_timestamp, MonTs}]. diff --git a/lib/kernel/src/user_drv.erl b/lib/kernel/src/user_drv.erl index ca3c53ff93..b794d4f45e 100644 --- a/lib/kernel/src/user_drv.erl +++ b/lib/kernel/src/user_drv.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -559,6 +559,7 @@ put_int16(N, Tail) -> %% is sent back to the process sending the request. This command was added in %% OTP 18 to make sure that data sent from io:format is actually printed %% to the console before the vm stops when calling erlang:halt(integer()). +-dialyzer({no_improper_lists, io_command/1}). io_command({put_chars_sync, unicode,Cs,Reply}) -> {{command,[?OP_PUTC_SYNC|unicode:characters_to_binary(Cs,utf8)]},Reply}; io_command({put_chars, unicode,Cs}) -> diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl index ef5303defd..2b77ec8972 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -323,6 +323,7 @@ load_abs(Config) when is_list(Config) -> {error, nofile} = code:load_abs(TestDir ++ "/duuuumy_mod"), {error, badfile} = code:load_abs(TestDir ++ "/code_a_test"), {'EXIT', _} = (catch code:load_abs({})), + {'EXIT', _} = (catch code:load_abs("Non-latin-имя-файла")), {module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"), code:stick_dir(TestDir), {error, sticky_directory} = code:load_abs(TestDir ++ "/code_b_test"), @@ -1599,6 +1600,17 @@ on_load_errors(Config) when is_list(Config) -> ok end, + %% Make sure that the code loading functions return the correct + %% error code. + Simple = simple_on_load_error, + SimpleList = atom_to_list(Simple), + {error,on_load_failure} = code:load_file(Simple), + {error,on_load_failure} = code:ensure_loaded(Simple), + {ok,SimpleCode} = file:read_file("simple_on_load_error.beam"), + {error,on_load_failure} = code:load_binary(Simple, "", SimpleCode), + {error,on_load_failure} = code:load_abs(SimpleList), + {error,on_load_failure} = code:load_abs(SimpleList, Simple), + ok. do_on_load_error(ReturnValue) -> diff --git a/lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl b/lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl new file mode 100644 index 0000000000..603c282257 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl @@ -0,0 +1,5 @@ +-module(simple_on_load_error). +-on_load(on_load/0). + +on_load() -> + nope. diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl index 7df0bc3d2f..6a63f7bc9c 100644 --- a/lib/kernel/test/seq_trace_SUITE.erl +++ b/lib/kernel/test/seq_trace_SUITE.erl @@ -35,6 +35,11 @@ %-define(line_trace, 1). -include_lib("test_server/include/test_server.hrl"). +-define(TIMESTAMP_MODES, [no_timestamp, + timestamp, + monotonic_timestamp, + strict_monotonic_timestamp]). + -define(default_timeout, ?t:minutes(1)). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -75,6 +80,17 @@ end_per_testcase(_Case, Config) -> token_set_get(doc) -> []; token_set_get(suite) -> []; token_set_get(Config) when is_list(Config) -> + do_token_set_get(timestamp), + do_token_set_get(monotonic_timestamp), + do_token_set_get(strict_monotonic_timestamp). + +do_token_set_get(TsType) -> + io:format("Testing ~p~n", [TsType]), + Flags = case TsType of + timestamp -> 15; + strict_monotonic_timestamp -> 23; + monotonic_timestamp -> 39 + end, ?line Self = self(), ?line seq_trace:reset_trace(), %% Test that initial seq_trace is disabled @@ -88,22 +104,22 @@ token_set_get(Config) when is_list(Config) -> ?line {send,true} = seq_trace:get_token(send), ?line false = seq_trace:set_token('receive',true), ?line {'receive',true} = seq_trace:get_token('receive'), - ?line false = seq_trace:set_token(timestamp,true), - ?line {timestamp,true} = seq_trace:get_token(timestamp), + ?line false = seq_trace:set_token(TsType,true), + ?line {TsType,true} = seq_trace:get_token(TsType), %% Check the whole token - ?line {15,17,0,Self,0} = seq_trace:get_token(), % all flags are set + ?line {Flags,17,0,Self,0} = seq_trace:get_token(), % all flags are set %% Test setting and reading the 'serial' field ?line {0,0} = seq_trace:set_token(serial,{3,5}), ?line {serial,{3,5}} = seq_trace:get_token(serial), %% Check the whole token, test that a whole token can be set and get - ?line {15,17,5,Self,3} = seq_trace:get_token(), - ?line seq_trace:set_token({15,19,7,Self,5}), - ?line {15,19,7,Self,5} = seq_trace:get_token(), + ?line {Flags,17,5,Self,3} = seq_trace:get_token(), + ?line seq_trace:set_token({Flags,19,7,Self,5}), + ?line {Flags,19,7,Self,5} = seq_trace:get_token(), %% Check that receive timeout does not reset token ?line receive after 0 -> ok end, - ?line {15,19,7,Self,5} = seq_trace:get_token(), + ?line {Flags,19,7,Self,5} = seq_trace:get_token(), %% Check that token can be unset - ?line {15,19,7,Self,5} = seq_trace:set_token([]), + ?line {Flags,19,7,Self,5} = seq_trace:set_token([]), ?line [] = seq_trace:get_token(), %% Check that Previous serial counter survived unset token ?line 0 = seq_trace:set_token(label, 17), @@ -139,30 +155,42 @@ tracer_set_get(Config) when is_list(Config) -> print(doc) -> []; print(suite) -> []; print(Config) when is_list(Config) -> + lists:foreach(fun do_print/1, ?TIMESTAMP_MODES). + +do_print(TsType) -> ?line start_tracer(), - ?line seq_trace:set_token(print,true), + ?line set_token_flags([print, TsType]), ?line seq_trace:print(0,print1), ?line seq_trace:print(1,print2), ?line seq_trace:print(print3), ?line seq_trace:reset_trace(), - ?line [{0,{print,_,_,[],print1}}, - {0,{print,_,_,[],print3}}] = stop_tracer(2). + ?line [{0,{print,_,_,[],print1}, Ts0}, + {0,{print,_,_,[],print3}, Ts1}] = stop_tracer(2), + check_ts(TsType, Ts0), + check_ts(TsType, Ts1). send(doc) -> []; send(suite) -> []; send(Config) when is_list(Config) -> + lists:foreach(fun do_send/1, ?TIMESTAMP_MODES). + +do_send(TsType) -> ?line seq_trace:reset_trace(), ?line start_tracer(), ?line Receiver = spawn(?MODULE,one_time_receiver,[]), - ?line seq_trace:set_token(send,true), + ?line set_token_flags([send, TsType]), ?line Receiver ! send, ?line Self = self(), ?line seq_trace:reset_trace(), - ?line [{0,{send,_,Self,Receiver,send}}] = stop_tracer(1). + ?line [{0,{send,_,Self,Receiver,send}, Ts}] = stop_tracer(1), + check_ts(TsType, Ts). distributed_send(doc) -> []; distributed_send(suite) -> []; distributed_send(Config) when is_list(Config) -> + lists:foreach(fun do_distributed_send/1, ?TIMESTAMP_MODES). + +do_distributed_send(TsType) -> ?line {ok,Node} = start_node(seq_trace_other,[]), ?line {_,Dir} = code:is_loaded(?MODULE), ?line Mdir = filename:dirname(Dir), @@ -170,30 +198,39 @@ distributed_send(Config) when is_list(Config) -> ?line seq_trace:reset_trace(), ?line start_tracer(), ?line Receiver = spawn(Node,?MODULE,one_time_receiver,[]), - ?line seq_trace:set_token(send,true), + ?line set_token_flags([send,TsType]), ?line Receiver ! send, ?line Self = self(), ?line seq_trace:reset_trace(), ?line stop_node(Node), - ?line [{0,{send,_,Self,Receiver,send}}] = stop_tracer(1). + ?line [{0,{send,_,Self,Receiver,send}, Ts}] = stop_tracer(1), + check_ts(TsType, Ts). + recv(doc) -> []; recv(suite) -> []; recv(Config) when is_list(Config) -> + lists:foreach(fun do_recv/1, ?TIMESTAMP_MODES). + +do_recv(TsType) -> ?line seq_trace:reset_trace(), ?line start_tracer(), ?line Receiver = spawn(?MODULE,one_time_receiver,[]), - ?line seq_trace:set_token('receive',true), + ?line set_token_flags(['receive',TsType]), ?line Receiver ! 'receive', %% let the other process receive the message: ?line receive after 1 -> ok end, ?line Self = self(), ?line seq_trace:reset_trace(), - ?line [{0,{'receive',_,Self,Receiver,'receive'}}] = stop_tracer(1). + ?line [{0,{'receive',_,Self,Receiver,'receive'}, Ts}] = stop_tracer(1), + check_ts(TsType, Ts). distributed_recv(doc) -> []; distributed_recv(suite) -> []; distributed_recv(Config) when is_list(Config) -> + lists:foreach(fun do_distributed_recv/1, ?TIMESTAMP_MODES). + +do_distributed_recv(TsType) -> ?line {ok,Node} = start_node(seq_trace_other,[]), ?line {_,Dir} = code:is_loaded(?MODULE), ?line Mdir = filename:dirname(Dir), @@ -201,7 +238,7 @@ distributed_recv(Config) when is_list(Config) -> ?line seq_trace:reset_trace(), ?line rpc:call(Node,?MODULE,start_tracer,[]), ?line Receiver = spawn(Node,?MODULE,one_time_receiver,[]), - ?line seq_trace:set_token('receive',true), + ?line set_token_flags(['receive',TsType]), ?line Receiver ! 'receive', %% let the other process receive the message: ?line receive after 1 -> ok end, @@ -210,16 +247,20 @@ distributed_recv(Config) when is_list(Config) -> ?line Result = rpc:call(Node,?MODULE,stop_tracer,[1]), ?line stop_node(Node), ?line ok = io:format("~p~n",[Result]), - ?line [{0,{'receive',_,Self,Receiver,'receive'}}] = Result. + ?line [{0,{'receive',_,Self,Receiver,'receive'}, Ts}] = Result, + check_ts(TsType, Ts). trace_exit(doc) -> []; trace_exit(suite) -> []; trace_exit(Config) when is_list(Config) -> + lists:foreach(fun do_trace_exit/1, ?TIMESTAMP_MODES). + +do_trace_exit(TsType) -> ?line seq_trace:reset_trace(), ?line start_tracer(), ?line Receiver = spawn_link(?MODULE, one_time_receiver, [exit]), ?line process_flag(trap_exit, true), - ?line seq_trace:set_token(send,true), + ?line set_token_flags([send, TsType]), ?line Receiver ! {before, exit}, %% let the other process receive the message: ?line receive @@ -233,13 +274,18 @@ trace_exit(Config) when is_list(Config) -> ?line Result = stop_tracer(2), ?line seq_trace:reset_trace(), ?line ok = io:format("~p~n", [Result]), - ?line [{0, {send, {0,1}, Self, Receiver, {before, exit}}}, + ?line [{0, {send, {0,1}, Self, Receiver, {before, exit}}, Ts0}, {0, {send, {1,2}, Receiver, Self, - {'EXIT', Receiver, {exit, {before, exit}}}}}] = Result. + {'EXIT', Receiver, {exit, {before, exit}}}}, Ts1}] = Result, + check_ts(TsType, Ts0), + check_ts(TsType, Ts1). distributed_exit(doc) -> []; distributed_exit(suite) -> []; distributed_exit(Config) when is_list(Config) -> + lists:foreach(fun do_distributed_exit/1, ?TIMESTAMP_MODES). + +do_distributed_exit(TsType) -> ?line {ok, Node} = start_node(seq_trace_other, []), ?line {_, Dir} = code:is_loaded(?MODULE), ?line Mdir = filename:dirname(Dir), @@ -248,7 +294,7 @@ distributed_exit(Config) when is_list(Config) -> ?line rpc:call(Node, ?MODULE, start_tracer,[]), ?line Receiver = spawn_link(Node, ?MODULE, one_time_receiver, [exit]), ?line process_flag(trap_exit, true), - ?line seq_trace:set_token(send, true), + ?line set_token_flags([send, TsType]), ?line Receiver ! {before, exit}, %% let the other process receive the message: ?line receive @@ -264,7 +310,8 @@ distributed_exit(Config) when is_list(Config) -> ?line stop_node(Node), ?line ok = io:format("~p~n", [Result]), ?line [{0, {send, {1, 2}, Receiver, Self, - {'EXIT', Receiver, {exit, {before, exit}}}}}] = Result. + {'EXIT', Receiver, {exit, {before, exit}}}}, Ts}] = Result, + check_ts(TsType, Ts). call(doc) -> "Tests special forms {is_seq_trace} and {get_seq_token} " @@ -361,14 +408,22 @@ port(doc) -> "Send trace messages to a port."; port(suite) -> []; port(Config) when is_list(Config) -> + lists:foreach(fun (TsType) -> do_port(TsType, Config) end, + ?TIMESTAMP_MODES). + +do_port(TsType, Config) -> + io:format("Testing ~p~n",[TsType]), ?line Port = load_tracer(Config), ?line seq_trace:set_system_tracer(Port), - ?line seq_trace:set_token(print, true), + ?line set_token_flags([print, TsType]), ?line Small = [small,term], ?line seq_trace:print(0, Small), ?line case get_port_message(Port) of - {seq_trace,0,{print,_,_,[],Small}} -> + {seq_trace,0,{print,_,_,[],Small}} when TsType == no_timestamp -> + ok; + {seq_trace,0,{print,_,_,[],Small},Ts0} when TsType /= no_timestamp -> + check_ts(TsType, Ts0), ok; Other -> ?line seq_trace:reset_trace(), @@ -382,7 +437,10 @@ port(Config) when is_list(Config) -> ?line seq_trace:print(0, OtherSmall), ?line seq_trace:reset_trace(), ?line case get_port_message(Port) of - {seq_trace,0,{print,_,_,[],OtherSmall}} -> + {seq_trace,0,{print,_,_,[],OtherSmall}} when TsType == no_timestamp -> + ok; + {seq_trace,0,{print,_,_,[],OtherSmall}, Ts1} when TsType /= no_timestamp -> + check_ts(TsType, Ts1), ok; Other1 -> ?line ?t:fail({unexpected,Other1}) @@ -399,6 +457,8 @@ port(Config) when is_list(Config) -> Other2 -> ?line ?t:fail({unexpected,Other2}) end, + unlink(Port), + exit(Port,kill), ok. get_port_message(Port) -> @@ -734,7 +794,7 @@ simple_tracer(Data, DN) -> {seq_trace,Label,Info,Ts} -> simple_tracer([{Label,Info,Ts}|Data], DN+1); {seq_trace,Label,Info} -> - simple_tracer([{Label,Info}|Data], DN+1); + simple_tracer([{Label,Info, no_timestamp}|Data], DN+1); {stop,N,From} when DN >= N -> From ! {tracerlog,lists:reverse(Data)} end. @@ -759,7 +819,55 @@ start_tracer() -> seq_trace:set_system_tracer(Pid), Pid. - + +set_token_flags([]) -> + ok; +set_token_flags([no_timestamp|Flags]) -> + seq_trace:set_token(timestamp, false), + seq_trace:set_token(monotonic_timestamp, false), + seq_trace:set_token(strict_monotonic_timestamp, false), + set_token_flags(Flags); +set_token_flags([Flag|Flags]) -> + seq_trace:set_token(Flag, true), + set_token_flags(Flags). + +check_ts(no_timestamp, Ts) -> + try + no_timestamp = Ts + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(timestamp, Ts) -> + try + {Ms,S,Us} = Ts, + true = is_integer(Ms), + true = is_integer(S), + true = is_integer(Us) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(monotonic_timestamp, Ts) -> + try + true = is_integer(Ts) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok; +check_ts(strict_monotonic_timestamp, Ts) -> + try + {MT, UMI} = Ts, + true = is_integer(MT), + true = is_integer(UMI) + catch + _ : _ -> + ?t:fail({unexpected_timestamp, Ts}) + end, + ok. start_node(Name, Param) -> test_server:start_node(Name, slave, [{args, Param}]). diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index 02c175760e..69ccc1d2c9 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -78,7 +78,7 @@ change_table_majority/1, del_active_replica/2, wait_for_tables/2, - get_network_copy/2, + get_network_copy/3, merge_schema/0, start_remote_sender/4, schedule_late_disc_load/2 @@ -329,14 +329,14 @@ release_schema_commit_lock() -> unlink(whereis(?SERVER_NAME)). %% Special for preparation of add table copy -get_network_copy(Tab, Cs) -> +get_network_copy(Tid, Tab, Cs) -> % We can't let the controller queue this one % because that may cause a deadlock between schema_operations % and initial tableloadings which both takes schema locks. % But we have to get copier_done msgs when the other side % goes down. call({add_other, self()}), - Reason = {dumper,add_table_copy}, + Reason = {dumper,{add_table_copy, Tid}}, Work = #net_load{table = Tab,reason = Reason,cstruct = Cs}, %% I'll need this cause it's linked trough the subscriber %% might be solved by using monitor in subscr instead. @@ -775,7 +775,7 @@ handle_call({net_load, Tab, Cs}, From, State) -> true -> Worker = #net_load{table = Tab, opt_reply_to = From, - reason = {dumper,add_table_copy}, + reason = {dumper,{add_table_copy, unknown}}, cstruct = Cs }, add_worker(Worker, State); @@ -1180,11 +1180,11 @@ handle_info(Done = #loader_done{worker_pid=WPid, table_name=Tab}, State0) -> Done#loader_done.needs_announce == true, Done#loader_done.needs_reply == true -> i_have_tab(Tab), - %% Should be {dumper,add_table_copy} only + %% Should be {dumper,{add_table_copy, _}} only reply(Done#loader_done.reply_to, Done#loader_done.reply); Done#loader_done.needs_reply == true -> - %% Should be {dumper,add_table_copy} only + %% Should be {dumper,{add_table_copy,_}} only reply(Done#loader_done.reply_to, Done#loader_done.reply); Done#loader_done.needs_announce == true, Tab == schema -> @@ -2148,6 +2148,10 @@ load_table_fun(#net_load{cstruct=Cs, table=Tab, reason=Reason, opt_reply_to=Repl reply_to = ReplyTo, reply = {loaded, ok} }, + AddTableCopy = case Reason of + {dumper,{add_table_copy,_}} -> true; + _ -> false + end, if ReadNode == node() -> %% Already loaded locally @@ -2157,7 +2161,7 @@ load_table_fun(#net_load{cstruct=Cs, table=Tab, reason=Reason, opt_reply_to=Repl Res = mnesia_loader:disc_load_table(Tab, load_local_content), Done#loader_done{reply = Res, needs_announce = true, needs_sync = true} end; - AccessMode == read_only, Reason /= {dumper,add_table_copy} -> + AccessMode == read_only, not AddTableCopy -> fun() -> disc_load_table(Tab, Reason, ReplyTo) end; true -> fun() -> diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl index da8549be50..41fcd76fcb 100644 --- a/lib/mnesia/src/mnesia_loader.erl +++ b/lib/mnesia/src/mnesia_loader.erl @@ -180,8 +180,7 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_only_copies - -define(MAX_RAM_TRANSFERS, (?MAX_RAM_FILE_SIZE div ?MAX_TRANSFER_SIZE) + 1). -define(MAX_NOPACKETS, 20). -net_load_table(Tab, Reason, Ns, Cs) - when Reason == {dumper,add_table_copy} -> +net_load_table(Tab, {dumper,{add_table_copy, _}}=Reason, Ns, Cs) -> try_net_load_table(Tab, Reason, Ns, Cs); net_load_table(Tab, Reason, Ns, _Cs) -> try_net_load_table(Tab, Reason, Ns, val({Tab, cstruct})). @@ -233,7 +232,8 @@ do_snmpify(Tab, Us, Storage) -> set({Tab, {index, snmp}}, Snmp). %% Start the recieiver -init_receiver(Node, Tab, Storage, Cs, Reas={dumper,add_table_copy}) -> +init_receiver(Node, Tab, Storage, Cs, Reas={dumper,{add_table_copy, Tid}}) -> + rpc:call(Node, mnesia_lib, set, [{?MODULE, active_trans}, Tid]), case start_remote_sender(Node, Tab, Storage) of {SenderPid, TabSize, DetsData} -> start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,Reas); @@ -307,7 +307,7 @@ table_init_fun(SenderPid) -> end. %% Add_table_copy get's it's own locks. -start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,{dumper,add_table_copy}) -> +start_receiver(Tab,Storage,Cs,SenderPid,TabSize,DetsData,{dumper,{add_table_copy,_}}) -> Init = table_init_fun(SenderPid), case do_init_table(Tab,Storage,Cs,SenderPid,TabSize,DetsData,self(), Init) of Err = {error, _} -> @@ -658,9 +658,10 @@ send_table(Pid, Tab, RemoteS) -> {Init, Chunk} = reader_funcs(UseDetsChunk, Tab, Storage, KeysPerTransfer), SendIt = fun() -> - {atomic, ok} = prepare_copy(Pid, Tab, Storage), + NeedLock = need_lock(Tab), + {atomic, ok} = prepare_copy(Pid, Tab, Storage, NeedLock), send_more(Pid, 1, Chunk, Init(), Tab), - finish_copy(Pid, Tab, Storage, RemoteS) + finish_copy(Pid, Tab, Storage, RemoteS, NeedLock) end, try SendIt() of @@ -678,10 +679,10 @@ send_table(Pid, Tab, RemoteS) -> end end. -prepare_copy(Pid, Tab, Storage) -> +prepare_copy(Pid, Tab, Storage, NeedLock) -> Trans = fun() -> - mnesia:lock_table(Tab, load), + NeedLock andalso mnesia:lock_table(Tab, load), mnesia_subscr:subscribe(Pid, {table, Tab}), update_where_to_write(Tab, node(Pid)), mnesia_lib:db_fixtable(Storage, Tab, true), @@ -689,6 +690,21 @@ prepare_copy(Pid, Tab, Storage) -> end, mnesia:transaction(Trans). + +need_lock(Tab) -> + case ?catch_val({?MODULE, active_trans}) of + #tid{} = Tid -> + %% move_table_copy grabs it's own table-lock + %% do not deadlock with it + mnesia_lib:unset({?MODULE, active_trans}), + case mnesia_locker:get_held_locks(Tab) of + [{write, Tid}|_] -> false; + _Locks -> true + end; + _ -> + true + end. + update_where_to_write(Tab, Node) -> case val({Tab, access_mode}) of read_only -> @@ -783,12 +799,12 @@ send_packet(N, Pid, Chunk, {Recs, Cont}) when N < ?MAX_NOPACKETS -> send_packet(_N, _Pid, _Chunk, DataState) -> DataState. -finish_copy(Pid, Tab, Storage, RemoteS) -> +finish_copy(Pid, Tab, Storage, RemoteS, NeedLock) -> RecNode = node(Pid), DatBin = dat2bin(Tab, Storage, RemoteS), Trans = fun() -> - mnesia:read_lock_table(Tab), + NeedLock andalso mnesia:read_lock_table(Tab), A = val({Tab, access_mode}), mnesia_controller:sync_and_block_table_whereabouts(Tab, RecNode, RemoteS, A), cleanup_tab_copier(Pid, Storage, Tab), diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl index 89feeba2c3..5766f22e92 100644 --- a/lib/mnesia/src/mnesia_locker.erl +++ b/lib/mnesia/src/mnesia_locker.erl @@ -22,7 +22,7 @@ -module(mnesia_locker). -export([ - get_held_locks/0, + get_held_locks/0, get_held_locks/1, get_lock_queue/0, global_lock/5, ixrlock/5, @@ -236,6 +236,11 @@ loop(State) -> From ! {Ref, ok}, loop(State); + {From, {is_locked, Oid}} -> + Held = ?ets_lookup(mnesia_held_locks, Oid), + reply(From, Held), + loop(State); + {'EXIT', Pid, _} when Pid == State#state.supervisor -> do_stop(); @@ -1151,6 +1156,19 @@ get_held_locks() -> Locks = receive {mnesia_held_locks, Ls} -> Ls after 5000 -> [] end, rewrite_locks(Locks, []). +%% Mnesia internal usage only +get_held_locks(Tab) when is_atom(Tab) -> + Oid = {Tab, ?ALL}, + ?MODULE ! {self(), {is_locked, Oid}}, + receive + {?MODULE, _Node, Locks} -> + case Locks of + [] -> []; + [{Oid, _Prev, What}] -> What + end + end. + + rewrite_locks([{Oid, _, Ls}|Locks], Acc0) -> Acc = rewrite_locks(Ls, Oid, Acc0), rewrite_locks(Locks, Acc); diff --git a/lib/mnesia/src/mnesia_monitor.erl b/lib/mnesia/src/mnesia_monitor.erl index 8313c3bda5..081d746257 100644 --- a/lib/mnesia/src/mnesia_monitor.erl +++ b/lib/mnesia/src/mnesia_monitor.erl @@ -82,9 +82,9 @@ going_down = [], tm_started = false, early_connects = [], connecting, mq = [], remote_node_status = []}). --define(current_protocol_version, {8,1}). +-define(current_protocol_version, {8,2}). --define(previous_protocol_version, {8,0}). +-define(previous_protocol_version, {8,1}). start() -> gen_server:start_link({local, ?MODULE}, ?MODULE, @@ -193,7 +193,7 @@ protocol_version() -> %% A sorted list of acceptable protocols the %% preferred protocols are first in the list acceptable_protocol_versions() -> - [protocol_version(), ?previous_protocol_version, {7,6}]. + [protocol_version(), ?previous_protocol_version]. needs_protocol_conversion(Node) -> case {?catch_val({protocol, Node}), protocol_version()} of @@ -424,8 +424,6 @@ handle_call({negotiate_protocol, Mon, Version, Protocols}, From, State) case hd(Protocols) of ?previous_protocol_version -> accept_protocol(Mon, MyVersion, ?previous_protocol_version, From, State); - {7,6} -> - accept_protocol(Mon, MyVersion, {7,6}, From, State); _ -> verbose("Connection with ~p rejected. " "version = ~p, protocols = ~p, " diff --git a/lib/mnesia/src/mnesia_schema.erl b/lib/mnesia/src/mnesia_schema.erl index 593360415d..782493fb4f 100644 --- a/lib/mnesia/src/mnesia_schema.erl +++ b/lib/mnesia/src/mnesia_schema.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2011. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -646,54 +646,18 @@ cs2list(Cs) when is_record(Cs, cstruct) -> rec2list(Tags, Tags, 2, Cs); cs2list(CreateList) when is_list(CreateList) -> CreateList; -%% 4.6 + +%% since 4.6 cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 19 -> Tags = [name,type,ram_copies,disc_copies,disc_only_copies, load_order,access_mode,majority,index,snmp,local_content, record_name,attributes, user_properties,frag_properties,storage_properties, cookie,version], - rec2list(Tags, Tags, 2, Cs); -%% 4.4.19 -cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 18 -> - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,majority,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], - rec2list(Tags, Tags, 2, Cs); -%% 4.4.18 and earlier -cs2list(Cs) when element(1, Cs) == cstruct, tuple_size(Cs) == 17 -> - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], rec2list(Tags, Tags, 2, Cs). cs2list(false, Cs) -> - cs2list(Cs); -cs2list(ver4_4_18, Cs) -> %% Or earlier - Orig = record_info(fields, cstruct), - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], - rec2list(Tags, Orig, 2, Cs); -cs2list(ver4_4_19, Cs) -> - Orig = record_info(fields, cstruct), - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,majority,index,snmp,local_content, - record_name,attributes,user_properties,frag_properties, - cookie,version], - rec2list(Tags, Orig, 2, Cs); -cs2list(ver4_6, Cs) -> - Orig = record_info(fields, cstruct), - Tags = [name,type,ram_copies,disc_copies,disc_only_copies, - load_order,access_mode,majority,index,snmp,local_content, - record_name,attributes, - user_properties,frag_properties,storage_properties, - cookie,version], - rec2list(Tags, Orig, 2, Cs). - + cs2list(Cs). rec2list([Tag | Tags], [Tag | Orig], Pos, Rec) -> Val = element(Pos, Rec), @@ -703,19 +667,8 @@ rec2list([], _, _Pos, _Rec) -> rec2list(Tags, [_|Orig], Pos, Rec) -> rec2list(Tags, Orig, Pos+1, Rec). -normalize_cs(Cstructs, Node) -> - %% backward-compatibility hack; normalize before returning - case need_old_cstructs([Node]) of - false -> - Cstructs; - Version -> - %% some other format - [convert_cs(Version, Cs) || Cs <- Cstructs] - end. - -convert_cs(Version, Cs) -> - Fields = [Value || {_, Value} <- cs2list(Version, Cs)], - list_to_tuple([cstruct|Fields]). +normalize_cs(Cstructs, _Node) -> + Cstructs. list2cs(List) when is_list(List) -> Name = pick(unknown, name, List, must), @@ -1142,6 +1095,7 @@ do_delete_table(Tab) -> ensure_writable(schema), insert_schema_ops(TidTs, make_delete_table(Tab, whole_table)). +-dialyzer({no_improper_lists, make_delete_table/2}). make_delete_table(Tab, Mode) -> case existed_before(Tab) of false -> @@ -1297,6 +1251,7 @@ make_del_table_copy(Tab, Node) -> _ -> ensure_active(Cs), verify_cstruct(Cs2), + get_tid_ts_and_lock(Tab, write), [{op, del_table_copy, Storage, Node, vsn_cs2list(Cs2)}] end. @@ -1324,6 +1279,7 @@ remove_node_from_tabs([Tab|Rest], Node) -> remove_node_from_tabs(Rest, Node)]; _Ns -> verify_cstruct(Cs2), + get_tid_ts_and_lock(Tab, write), [{op, del_table_copy, ram_copies, Node, vsn_cs2list(Cs2)}| remove_node_from_tabs(Rest, Node)] end @@ -1355,6 +1311,11 @@ do_move_table(schema, _FromNode, _ToNode) -> mnesia:abort({bad_type, schema}); do_move_table(Tab, FromNode, ToNode) when is_atom(FromNode), is_atom(ToNode) -> TidTs = get_tid_ts_and_lock(schema, write), + AnyOld = lists:any(fun(Node) -> mnesia_monitor:needs_protocol_conversion(Node) end, + [ToNode|val({Tab, where_to_write})]), + if AnyOld -> ignore; %% Leads to deadlock on old nodes + true -> get_tid_ts_and_lock(Tab, write) + end, insert_schema_ops(TidTs, make_move_table(Tab, FromNode, ToNode)); do_move_table(Tab, FromNode, ToNode) -> mnesia:abort({badarg, Tab, FromNode, ToNode}). @@ -1962,7 +1923,7 @@ prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}, _WaitFor) -> end, %% Tables are created by mnesia_loader get_network code insert_cstruct(Tid, Cs, true), - case mnesia_controller:get_network_copy(Tab, Cs) of + case mnesia_controller:get_network_copy(Tid, Tab, Cs) of {loaded, ok} -> {true, optional}; {not_loaded, ErrReason} -> @@ -1993,28 +1954,11 @@ prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}, _WaitFor) -> {true, optional} end; -prepare_op(Tid, {op, del_table_copy, _Storage, Node, TabDef}, _WaitFor) -> +prepare_op(_Tid, {op, del_table_copy, _Storage, Node, TabDef}, _WaitFor) -> Cs = list2cs(TabDef), Tab = Cs#cstruct.name, - - if - %% Schema table lock is always required to run a schema op. - %% No need to look it. - node(Tid#tid.pid) == node(), Tab /= schema -> - Self = self(), - Pid = spawn_link(fun() -> lock_del_table(Tab, Node, Cs, Self) end), - put(mnesia_lock, Pid), - receive - {Pid, updated} -> - {true, optional}; - {Pid, FailReason} -> - mnesia:abort(FailReason); - {'EXIT', Pid, Reason} -> - mnesia:abort(Reason) - end; - true -> - {true, optional} - end; + set_where_to_read(Tab, Node, Cs), + {true, optional}; prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}, _WaitFor) when N == node() -> @@ -2228,46 +2172,6 @@ receive_sync(Nodes, Pids) -> {abort, Else} end. -lock_del_table(Tab, NewNode, Cs0, Father) -> - Ns = val({schema, active_replicas}), - process_flag(trap_exit,true), - Lock = fun() -> - mnesia:write_lock_table(Tab), - %% Sigh using cs record - Set = fun(Node) -> - [Cs] = normalize_cs([Cs0], Node), - rpc:call(Node, ?MODULE, set_where_to_read, [Tab, NewNode, Cs]) - end, - Res = [Set(Node) || Node <- Ns], - Filter = fun(ok) -> - false; - ({badrpc, {'EXIT', {undef, _}}}) -> - %% This will be the case we talks with elder nodes - %% than 3.8.2, they will set where_to_read without - %% getting a lock. - false; - (_) -> - true - end, - case lists:filter(Filter, Res) of - [] -> - Father ! {self(), updated}, - %% When transaction is commited the process dies - %% and the lock is released. - receive _ -> ok end; - Err -> - Father ! {self(), {bad_commit, Err}} - end, - ok - end, - case mnesia:transaction(Lock) of - {atomic, ok} -> ok; - {aborted, R} -> Father ! {self(), R} - end, - unlink(Father), - unlink(whereis(mnesia_tm)), - exit(normal). - set_where_to_read(Tab, Node, Cs) -> case mnesia_lib:val({Tab, where_to_read}) of Node -> @@ -2418,13 +2322,19 @@ undo_prepare_op(Tid, {op, add_table_copy, Storage, Node, TabDef}) -> insert_cstruct(Tid, Cs2, true) % Don't care about the version end; -undo_prepare_op(_Tid, {op, del_table_copy, _, Node, TabDef}) - when Node == node() -> - WriteLocker = get(mnesia_lock), - WriteLocker =/= undefined andalso (WriteLocker ! die), +undo_prepare_op(_Tid, {op, del_table_copy, _, Node, TabDef}) -> Cs = list2cs(TabDef), Tab = Cs#cstruct.name, - mnesia_lib:set({Tab, where_to_read}, Node); + if node() =:= Node -> + mnesia_lib:set({Tab, where_to_read}, Node); + true -> + case mnesia_lib:val({Tab, where_to_read}) of + nowhere -> + mnesia_lib:set_remote_where_to_read(Tab); + _ -> + ignore + end + end; undo_prepare_op(_Tid, {op, change_table_copy_type, N, FromS, ToS, TabDef}) when N == node() -> @@ -2885,40 +2795,11 @@ do_merge_schema(LockTabs0) -> end. fetch_cstructs(Node) -> - case need_old_cstructs([Node]) of - false -> - rpc:call(Node, mnesia_controller, get_remote_cstructs, []); - _Ver -> - case rpc:call(Node, mnesia_controller, get_cstructs, []) of - {cstructs, Cs0, RR} -> - {cstructs, [list2cs(cs2list(Cs)) || Cs <- Cs0], RR}; - Err -> Err - end - end. + rpc:call(Node, mnesia_controller, get_remote_cstructs, []). -need_old_cstructs() -> - need_old_cstructs(val({schema, where_to_write})). - -need_old_cstructs(Nodes) -> - Filter = fun(Node) -> not mnesia_monitor:needs_protocol_conversion(Node) end, - case lists:dropwhile(Filter, Nodes) of - [] -> false; - [Node|_] -> - case rpc:call(Node, mnesia_lib, val, [{schema,cstruct}]) of - #cstruct{} -> - %% mnesia_lib:warning("Mnesia on ~p do not need to convert cstruct (~p)~n", - %% [node(), Node]), - false; - {badrpc, _} -> - need_old_cstructs(lists:delete(Node,Nodes)); - Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 17 -> - ver4_4_18; % Without majority - Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 18 -> - ver4_4_19; % With majority - Cs when element(1, Cs) == cstruct, tuple_size(Cs) == 19 -> - ver4_6 % With storage_properties - end - end. +need_old_cstructs() -> false. + +need_old_cstructs(_Nodes) -> false. tab_to_nodes(Tab) when is_atom(Tab) -> Cs = val({Tab, cstruct}), diff --git a/lib/mnesia/test/mnesia_isolation_test.erl b/lib/mnesia/test/mnesia_isolation_test.erl index b66da6e390..4dd0c01d05 100644 --- a/lib/mnesia/test/mnesia_isolation_test.erl +++ b/lib/mnesia/test/mnesia_isolation_test.erl @@ -39,7 +39,7 @@ groups() -> [{locking, [], [no_conflict, simple_queue_conflict, advanced_queue_conflict, simple_deadlock_conflict, - advanced_deadlock_conflict, lock_burst, + advanced_deadlock_conflict, schema_deadlock, lock_burst, {group, sticky_locks}, {group, unbound_locking}, {group, admin_conflict}, nasty]}, {sticky_locks, [], [basic_sticky_functionality]}, @@ -148,20 +148,32 @@ simple_queue_conflict(Config) when is_list(Config) -> fun_loop(Fun, AllSharedLocks, OneExclusiveLocks), ok. -wait_for_lock(Pid, _Nodes, 0) -> +wait_for_lock(Pid, Nodes, Retry) -> + wait_for_lock(Pid, Nodes, Retry, queue). + +wait_for_lock(Pid, _Nodes, 0, queue) -> Queue = mnesia:system_info(lock_queue), ?error("Timeout while waiting for lock on Pid ~p in queue ~p~n", [Pid, Queue]); -wait_for_lock(Pid, Nodes, N) -> - rpc:multicall(Nodes, sys, get_status, [mnesia_locker]), - List = [rpc:call(Node, mnesia, system_info, [lock_queue]) || Node <- Nodes], +wait_for_lock(Pid, _Nodes, 0, held) -> + Held = mnesia:system_info(held_locks), + ?error("Timeout while waiting for lock on Pid ~p (held) ~p~n", [Pid, Held]); +wait_for_lock(Pid, Nodes, N, Where) -> + rpc:multicall(Nodes, sys, get_status, [mnesia_locker]), + List = case Where of + queue -> + [rpc:call(Node, mnesia, system_info, [lock_queue]) || Node <- Nodes]; + held -> + [rpc:call(Node, mnesia, system_info, [held_locks]) || Node <- Nodes] + end, Q = lists:append(List), - check_q(Pid, Q, Nodes, N). + check_q(Pid, Q, Nodes, N, Where). -check_q(Pid, [{_Oid, _Op, Pid, _Tid, _WFT} | _Tail], _N, _Count) -> ok; -check_q(Pid, [_ | Tail], N, Count) -> check_q(Pid, Tail, N, Count); -check_q(Pid, [], N, Count) -> - timer:sleep(500), - wait_for_lock(Pid, N, Count - 1). +check_q(Pid, [{_Oid, _Op, Pid, _Tid, _WFT} | _Tail], _N, _Count, _Where) -> ok; +check_q(Pid, [{_Oid, _Op, {tid,_,Pid}} | _Tail], _N, _Count, _Where) -> ok; +check_q(Pid, [_ | Tail], N, Count, Where) -> check_q(Pid, Tail, N, Count, Where); +check_q(Pid, [], N, Count, Where) -> + timer:sleep(200), + wait_for_lock(Pid, N, Count - 1, Where). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -270,6 +282,43 @@ advanced_deadlock_conflict(Config) when is_list(Config) -> ?match([], mnesia:system_info(lock_queue)), ok. +%% Verify (and regression test) deadlock in del_table_copy(schema, Node) +schema_deadlock(Config) when is_list(Config) -> + Ns = [Node1, Node2] = ?acquire_nodes(2, Config), + ?match({atomic, ok}, mnesia:create_table(a, [{disc_copies, Ns}])), + ?match({atomic, ok}, mnesia:create_table(b, [{disc_copies, Ns}])), + + Tester = self(), + + Deadlocker = fun() -> + mnesia:write({a,1,1}), %% grab write lock on A + receive + continue -> + mnesia:write({b,1,1}), %% grab write lock on B + end_trans + end + end, + + ?match(stopped, rpc:call(Node2, mnesia, stop, [])), + timer:sleep(500), %% Let Node1 reconfigure + sys:get_status(mnesia_monitor), + + DoingTrans = spawn_link(fun() -> Tester ! {self(),mnesia:transaction(Deadlocker)} end), + wait_for_lock(DoingTrans, [Node1], 10, held), + %% Will grab write locks on schema, a, and b + DoingSchema = spawn_link(fun() -> Tester ! {self(), mnesia:del_table_copy(schema, Node2)} end), + timer:sleep(500), %% Let schema trans start, and try to grab locks + DoingTrans ! continue, + + ?match(ok, receive {DoingTrans, {atomic, end_trans}} -> ok after 5000 -> timeout end), + ?match(ok, receive {DoingSchema, {atomic, ok}} -> ok after 5000 -> timeout end), + + sys:get_status(whereis(mnesia_locker)), % Explicit sync, release locks is async + ?match([], mnesia:system_info(held_locks)), + ?match([], mnesia:system_info(lock_queue)), + ok. + + one_oid(Tab) -> {Tab, 1}. other_oid(Tab) -> {Tab, 2}. diff --git a/lib/observer/src/observer_tv_table.erl b/lib/observer/src/observer_tv_table.erl index 88f606b3e4..75e6919642 100644 --- a/lib/observer/src/observer_tv_table.erl +++ b/lib/observer/src/observer_tv_table.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2014. All Rights Reserved. +%% Copyright Ericsson AB 2011-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -669,6 +669,7 @@ merge([], New, _Key) -> merge(Old, New, Key) -> merge2(keysort(Key, Old), keysort(Key, New), Key). +-dialyzer({no_improper_lists, merge2/3}). merge2([[Obj|_]|Old], [Obj|New], Key) -> [[Obj]|merge2(Old, New, Key)]; merge2([[A|Op]|Old], [B|New], Key) diff --git a/lib/public_key/doc/src/public_key.xml b/lib/public_key/doc/src/public_key.xml index 258e7cd1b9..16a7497a22 100644 --- a/lib/public_key/doc/src/public_key.xml +++ b/lib/public_key/doc/src/public_key.xml @@ -114,8 +114,8 @@ </item> <tag><c>pem_entry () =</c></tag> - <item><p><c>{pki_asn1_type(), binary(), %% DER or encrypted DER not_encrypted</c></p> - <p><c>| cipher_info()}</c></p></item> + <item><p><c>{pki_asn1_type(), binary(), %% DER or encrypted DER</c></p> + <p><c> not_encrypted | cipher_info()}</c></p></item> <tag><c>cipher_info() = </c></tag> <item><p><c>{"RC2-CBC" | "DES-CBC" | "DES-EDE3-CBC", crypto:rand_bytes(8)</c></p> @@ -786,13 +786,13 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <fsummary>Decodes an SSH file-binary.</fsummary> <type> <v>SshBin = binary()</v> - <d>Example {ok, SshBin} = file:read_file("known_hosts").</d> + <d>Example <c>{ok, SshBin} = file:read_file("known_hosts")</c>.</d> <v>Type = public_key | ssh_file()</v> <d>If <c>Type</c> is <c>public_key</c> the binary can be either an RFC4716 public key or an OpenSSH public key.</d> </type> <desc> - <p>Decodes an SSH file-binary. In the case of <c>know_hosts</c> or + <p>Decodes an SSH file-binary. In the case of <c>known_hosts</c> or <c>auth_keys</c>, the binary can include one or more lines of the file. Returns a list of public keys and their attributes, possible attribute values depends on the file type represented by the @@ -842,7 +842,7 @@ fun(#'DistributionPoint'{}, #'CertificateList'{}, <v>Key = rsa_public_key() | dsa_public_key() | ec_public_key()</v> </type> <desc> - <p>Veryfies a digital signature.</p> + <p>Verifies a digital signature.</p> </desc> </func> diff --git a/lib/public_key/doc/src/public_key_records.xml b/lib/public_key/doc/src/public_key_records.xml index fb03da3150..d34f3ed9a3 100644 --- a/lib/public_key/doc/src/public_key_records.xml +++ b/lib/public_key/doc/src/public_key_records.xml @@ -57,9 +57,9 @@ <taglist> <tag><c>time() =</c></tag> - <item><p><c>uct_time() | general_time()</c></p></item> + <item><p><c>utc_time() | general_time()</c></p></item> - <tag><c>uct_time() =</c></tag> + <tag><c>utc_time() =</c></tag> <item><p><c>{utcTime, "YYMMDDHHMMSSZ"}</c></p></item> <tag><c>general_time() =</c></tag> @@ -144,7 +144,7 @@ <section> <title>DSA</title> - <p>Erlang representation of <url href="http://www.ietf.org/rfc/rfc6979.txt">Digigital Signature Algorithm (DSA)</url> keys</p> + <p>Erlang representation of <url href="http://www.ietf.org/rfc/rfc6979.txt">Digital Signature Algorithm (DSA)</url> keys</p> <code> #'DSAPrivateKey',{ version, % integer() diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl index d2a7d734c1..6eea1a0917 100644 --- a/lib/runtime_tools/src/dbg.erl +++ b/lib/runtime_tools/src/dbg.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1269,13 +1269,15 @@ gen_reader(follow_file, Filename) -> %% Opens a file and returns a reader (lazy list). gen_reader_file(ReadFun, Filename) -> - case file:open(Filename, [read, raw, binary]) of + case file:open(Filename, [read, raw, binary, read_ahead]) of {ok, File} -> mk_reader(ReadFun, File); Error -> exit({client_cannot_open, Error}) end. +-dialyzer({no_improper_lists, mk_reader/2}). + %% Creates and returns a reader (lazy list). mk_reader(ReadFun, Source) -> fun() -> @@ -1294,13 +1296,15 @@ mk_reader(ReadFun, Source) -> mk_reader_wrap([]) -> []; mk_reader_wrap([Hd | _] = WrapFiles) -> - case file:open(wrap_name(Hd), [read, raw, binary]) of + case file:open(wrap_name(Hd), [read, raw, binary, read_ahead]) of {ok, File} -> mk_reader_wrap(WrapFiles, File); Error -> exit({client_cannot_open, Error}) end. +-dialyzer({no_improper_lists, mk_reader_wrap/2}). + mk_reader_wrap([_Hd | Tail] = WrapFiles, File) -> fun() -> case read_term(fun file_read/2, File) of diff --git a/lib/sasl/doc/src/overload.xml b/lib/sasl/doc/src/overload.xml index 5c3d00afeb..2f19cd9088 100644 --- a/lib/sasl/doc/src/overload.xml +++ b/lib/sasl/doc/src/overload.xml @@ -35,6 +35,12 @@ <module>overload</module> <modulesummary>An Overload Regulation Process</modulesummary> <description> + <warning> + <p> + All functions in this module are deprecated and will be + removed in a future release. + </p> + </warning> <p><c>overload</c> is a process that indirectly regulates the CPU usage in the system. The idea is that a main application calls function diff --git a/lib/sasl/doc/src/sasl_app.xml b/lib/sasl/doc/src/sasl_app.xml index 8d79251c7e..bcd446a868 100644 --- a/lib/sasl/doc/src/sasl_app.xml +++ b/lib/sasl/doc/src/sasl_app.xml @@ -34,7 +34,7 @@ <p>The <c>SASL</c> application provides the following services:</p> <list type="bulleted"> <item><c>alarm_handler</c></item> - <item><c>overload</c></item> + <item><c>overload</c> (deprecated)</item> <item><c>rb</c></item> <item><c>release_handler</c></item> <item><c>systools</c></item> @@ -145,11 +145,15 @@ <p>Specifies the maximum intensity for <seealso marker="overload"><c>overload</c></seealso>. Default is <c>0.8</c>.</p> + <p>Note that the <c>overload</c> module is deprected and + will be removed in a future release.</p> </item> <tag><c><![CDATA[overload_weight = float() > 0 ]]></c></tag> <item> <p>Specifies the <seealso marker="overload"><c>overload</c></seealso> weight. Default is <c>0.1</c>.</p> + <p>Note that the <c>overload</c> module is deprected and + will be removed in a future release.</p> </item> <tag><c><![CDATA[start_prg = string() ]]></c></tag> <item> diff --git a/lib/sasl/src/overload.erl b/lib/sasl/src/overload.erl index 61b925d219..bc8ab7d5e4 100644 --- a/lib/sasl/src/overload.erl +++ b/lib/sasl/src/overload.erl @@ -19,6 +19,8 @@ %% -module(overload). +-deprecated(module). + -export([start_link/0, request/0, set_config_data/2, get_overload_info/0]). diff --git a/lib/sasl/src/release_handler_1.erl b/lib/sasl/src/release_handler_1.erl index 536ac924d4..a6325270a5 100644 --- a/lib/sasl/src/release_handler_1.erl +++ b/lib/sasl/src/release_handler_1.erl @@ -587,12 +587,12 @@ get_supervised_procs() -> get_application_names()). get_supervised_procs(_, Root, Procs, {ok, SupMod}) -> - get_procs(maybe_supervisor_which_children(get_proc_state(Root), SupMod, Root), Root) ++ + get_procs(maybe_supervisor_which_children(Root, SupMod, Root), Root) ++ [{undefined, undefined, Root, [SupMod]} | Procs]; get_supervised_procs(Application, Root, Procs, {error, _}) -> error_logger:error_msg("release_handler: cannot find top supervisor for " "application ~w~n", [Application]), - get_procs(maybe_supervisor_which_children(get_proc_state(Root), Application, Root), Root) ++ Procs. + get_procs(maybe_supervisor_which_children(Root, Application, Root), Root) ++ Procs. get_application_names() -> lists:map(fun({Application, _Name, _Vsn}) -> @@ -613,33 +613,54 @@ get_procs([{Name, Pid, worker, Mods} | T], Sup) when is_pid(Pid), is_list(Mods) [{Sup, Name, Pid, Mods} | get_procs(T, Sup)]; get_procs([{Name, Pid, supervisor, Mods} | T], Sup) when is_pid(Pid) -> [{Sup, Name, Pid, Mods} | get_procs(T, Sup)] ++ - get_procs(maybe_supervisor_which_children(get_proc_state(Pid), Name, Pid), Pid); + get_procs(maybe_supervisor_which_children(Pid, Name, Pid), Pid); get_procs([_H | T], Sup) -> get_procs(T, Sup); get_procs(_, _Sup) -> []. +maybe_supervisor_which_children(Proc, Name, Pid) -> + case get_proc_state(Proc) of + noproc -> + %% process exited before we could interrogate it. + %% not necessarily a bug, but reporting a warning as a curiosity. + error_logger:warning_msg("release_handler: a process (~p) exited" + " during supervision tree interrogation." + " Continuing ...~n", [Proc]), + []; + + suspended -> + error_logger:error_msg("release_handler: a which_children call" + " to ~p (~w) was avoided. This supervisor" + " is suspended and should likely be upgraded" + " differently. Exiting ...~n", [Name, Pid]), + error(suspended_supervisor); + + running -> + case catch supervisor:which_children(Pid) of + Res when is_list(Res) -> + Res; + Other -> + error_logger:error_msg("release_handler: ~p~nerror during" + " a which_children call to ~p (~w)." + " [State: running] Exiting ... ~n", + [Other, Name, Pid]), + error(which_children_failed) + end + end. + get_proc_state(Proc) -> - {status, _, {module, _}, [_, State, _, _, _]} = sys:get_status(Proc), - State. - -maybe_supervisor_which_children(suspended, Name, Pid) -> - error_logger:error_msg("release_handler: a which_children call" - " to ~p (~w) was avoided. This supervisor" - " is suspended and should likely be upgraded" - " differently. Exiting ...~n", [Name, Pid]), - error(suspended_supervisor); - -maybe_supervisor_which_children(State, Name, Pid) -> - case catch supervisor:which_children(Pid) of - Res when is_list(Res) -> - Res; - Other -> - error_logger:error_msg("release_handler: ~p~nerror during" - " a which_children call to ~p (~w)." - " [State: ~p] Exiting ... ~n", - [Other, Name, Pid, State]), - error(which_children_failed) + %% sys:send_system_msg can exit with {noproc, {m,f,a}}. + %% This happens if a supervisor exits after which_children has provided + %% its pid for interrogation. + %% ie. Proc may no longer be running at this point. + try sys:get_status(Proc) of + %% as per sys:get_status/1, SysState can only be running | suspended. + {status, _, {module, _}, [_, State, _, _, _]} when State == running ; + State == suspended -> + State + catch exit:{noproc, {sys, get_status, [Proc]}} -> + noproc end. maybe_get_dynamic_mods(Name, Pid) -> @@ -655,48 +676,19 @@ maybe_get_dynamic_mods(Name, Pid) -> error(get_modules_failed) end. -%% XXXX -%% Note: The following is a terrible hack done in order to resolve the -%% problem stated in ticket OTP-3452. - -%% XXXX NOTE WELL: This record is from supervisor.erl. Also the record -%% name is really `state'. --record(supervisor_state, {name, - strategy, - children = [], - dynamics = [], - intensity, - period, - restarts = [], - module, - args}). - %% Return the name of the call-back module that implements the %% (top) supervisor SupPid. %% Returns: {ok, Module} | {error,undefined} %% get_supervisor_module(SupPid) -> - case catch get_supervisor_module1(SupPid) of - {ok, Module} when is_atom(Module) -> + case catch supervisor:get_callback_module(SupPid) of + Module when is_atom(Module) -> {ok, Module}; _Other -> io:format("~w: reason: ~w~n", [SupPid, _Other]), {error, undefined} end. -get_supervisor_module1(SupPid) -> - {status, _Pid, {module, _Mod}, - [_PDict, _SysState, _Parent, _Dbg, Misc]} = sys:get_status(SupPid), - %% supervisor Misc field changed at R13B04, handle old and new variants here - State = case Misc of - [_Name, State1, _Type, _Time] -> - State1; - [_Header, _Data, {data, [{"State", State2}]}] -> - State2 - end, - %% Cannot use #supervisor_state{module = Module} = State. - {ok, element(#supervisor_state.module, State)}. - %%----------------------------------------------------------------- %% Func: do_soft_purge/3 %% Args: Mod = atom() diff --git a/lib/sasl/src/sasl.app.src b/lib/sasl/src/sasl.app.src index 705bb73fc5..507e2dc229 100644 --- a/lib/sasl/src/sasl.app.src +++ b/lib/sasl/src/sasl.app.src @@ -46,6 +46,6 @@ {env, [{sasl_error_logger, tty}, {errlog_type, all}]}, {mod, {sasl, []}}, - {runtime_dependencies, ["tools-2.6.14","stdlib-2.6","kernel-4.1", + {runtime_dependencies, ["tools-2.6.14","stdlib-2.8","kernel-4.1", "erts-6.0"]}]}. diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index d57de2593a..ee620dcdb4 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -1363,7 +1363,7 @@ upgrade_supervisor(Conf) when is_list(Conf) -> %% Check that the restart strategy and child spec is updated {status, _, {module, _}, [_, _, _, _, [_,_,{data,[{"State",State}]}]]} = rpc:call(Node,sys,get_status,[a_sup]), - {state,_,RestartStrategy,[Child],_,_,_,_,_,_} = State, + {state,_,RestartStrategy,[Child],_,_,_,_,_,_,_} = State, one_for_all = RestartStrategy, % changed from one_for_one {child,_,_,_,_,brutal_kill,_,_} = Child, % changed from timeout 2000 diff --git a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl index 586b7c7171..9e6aa74d45 100644 --- a/lib/snmp/src/agent/snmp_view_based_acm_mib.erl +++ b/lib/snmp/src/agent/snmp_view_based_acm_mib.erl @@ -34,6 +34,8 @@ %% Internal exports -export([check_vacm/1]). +%% +-export([emask2imask/1]). -include("snmp_types.hrl"). diff --git a/lib/snmp/src/agent/snmpa_acm.erl b/lib/snmp/src/agent/snmpa_acm.erl index 7327575846..0264c6a992 100644 --- a/lib/snmp/src/agent/snmpa_acm.erl +++ b/lib/snmp/src/agent/snmpa_acm.erl @@ -280,7 +280,7 @@ validate_mib_view(Oid, MibView) -> end. get_largest_family([{SubTree, Mask, Type} | T], Oid, Res) -> - case check_mask(Oid, SubTree, Mask) of + case check_mask(Oid, SubTree, snmp_view_based_acm_mib:emask2imask(Mask)) of true -> get_largest_family(T, Oid, add_res(length(SubTree), SubTree, Type, Res)); false -> get_largest_family(T, Oid, Res) @@ -345,7 +345,7 @@ validate_all_mib_view([], _MibView) -> %% intelligent. %%----------------------------------------------------------------- is_definitely_not_in_mib_view(Oid, [{SubTree, Mask,?view_included}|T]) -> - case check_maybe_mask(Oid, SubTree, Mask) of + case check_maybe_mask(Oid, SubTree, snmp_view_based_acm_mib:emask2imask(Mask)) of true -> false; false -> is_definitely_not_in_mib_view(Oid, T) end; diff --git a/lib/snmp/src/app/snmp.appup.src b/lib/snmp/src/app/snmp.appup.src index 77418f920f..ca61782639 100644 --- a/lib/snmp/src/app/snmp.appup.src +++ b/lib/snmp/src/app/snmp.appup.src @@ -1,71 +1,24 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% - - +%% -*- erlang -*- {"%VSN%", %% ----- U p g r a d e ------------------------------------------------------- - %% Instruction examples: %% {restart_application, snmp} %% {load_module, snmp_pdus, soft_purge, soft_purge, []} %% {update, snmpa_local_db, soft, soft_purge, soft_purge, []} %% {add_module, snmpm_net_if_mt} [ - {"5.2", [{load_module, snmp_conf, soft_purge, soft_purge, []}]}, - {"5.1.2", [ % Only runtime dependencies change - ]}, - {"5.1.1", [{restart_application, snmp}]}, - {"5.1", [ % Only compiler changes - ]}, - {"5.0", [{restart_application, snmp}]}, - {"4.25.1", [{restart_application, snmp}]}, - {"4.25.0.1", [{restart_application, snmp}]}, - {"4.25.0.0.1", [{restart_application, snmp}]}, - {"4.25", [{restart_application, snmp}]}, - {"4.24.2", [{restart_application, snmp}]}, - {"4.24.1", [{restart_application, snmp}]}, - {"4.24", [{restart_application, snmp}]} - ], - + {<<"5\\..*">>, [{restart_application, snmp}]}, + {<<"4\\..*">>, [{restart_application, snmp}]} + ], + %% ------D o w n g r a d e --------------------------------------------------- - %% Instruction examples: %% {remove, {snmpm_net_if_mt, soft_purge, soft_purge}} - + [ - {"5.2", [{load_module, snmp_conf, soft_purge, soft_purge, []}]}, - {"5.1.2", [ % Only runtime dependencies change - ]}, - {"5.1.1", [{restart_application, snmp}]}, - {"5.1", [ % Only compiler changes - ]}, - {"5.0", [{restart_application, snmp}]}, - {"4.25.1", [{restart_application, snmp}]}, - {"4.25.0.1", [{restart_application, snmp}]}, - {"4.25.0.0.1", [{restart_application, snmp}]}, - {"4.25", [{restart_application, snmp}]}, - {"4.24.2", [{restart_application, snmp}]}, - {"4.24.1", [{restart_application, snmp}]}, - {"4.24", [{restart_application, snmp}]} - ] - -}. + {<<"5\\..*">>, [{restart_application, snmp}]}, + {<<"4\\..*">>, [{restart_application, snmp}]} + ] +}. diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index 8fb689fdd5..75e1615c09 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -30,6 +30,24 @@ <file>notes.xml</file> </header> +<section><title>Ssh 4.2.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + The authentication method 'keyboard-interactive' failed + in the Erlang client when the server after successful + authentication continued by asking for zero more + passwords.</p> + <p> + Own Id: OTP-13225</p> + </item> + </list> + </section> + +</section> + <section><title>Ssh 4.2</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/ssh/src/ssh_auth.erl b/lib/ssh/src/ssh_auth.erl index fdbb5c152a..b71bed033a 100644 --- a/lib/ssh/src/ssh_auth.erl +++ b/lib/ssh/src/ssh_auth.erl @@ -477,7 +477,7 @@ keyboard_interact_get_responses(_, undefined, Password, _, _, _, _, _, 1) when Password =/= undefined -> [Password]; %% Password auth implemented with keyboard-interaction and passwd is known keyboard_interact_get_responses(_, _, _, _, _, _, _, _, 0) -> - [""]; + []; keyboard_interact_get_responses(false, undefined, undefined, _, _, _, [Prompt|_], Opts, _) -> ssh_no_io:read_line(Prompt, Opts); %% Throws error as keyboard interaction is not allowed keyboard_interact_get_responses(true, undefined, _,IoCb, Name, Instr, PromptInfos, Opts, _) -> diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index f082db136c..ce1931e4f4 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -648,10 +648,12 @@ userauth_keyboard_interactive(Msg = #ssh_msg_userauth_failure{}, userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_failure{}, #state{ssh_params = #ssh{role = client}} = State) -> userauth(Msg, State); - userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_success{}, #state{ssh_params = #ssh{role = client}} = State) -> - userauth(Msg, State). + userauth(Msg, State); +userauth_keyboard_interactive_info_response(Msg=#ssh_msg_userauth_info_request{}, + #state{ssh_params = #ssh{role = client}} = State) -> + userauth_keyboard_interactive(Msg, State). %%-------------------------------------------------------------------- -spec connected({#ssh_msg_kexinit{}, binary()}, %%| %% #ssh_msg_kexdh_init{}, diff --git a/lib/ssh/test/Makefile b/lib/ssh/test/Makefile index 781a876723..9cd98f069f 100644 --- a/lib/ssh/test/Makefile +++ b/lib/ssh/test/Makefile @@ -35,9 +35,8 @@ MODULES= \ ssh_algorithms_SUITE \ ssh_options_SUITE \ ssh_renegotiate_SUITE \ - \ ssh_basic_SUITE \ - \ + ssh_benchmark_SUITE \ ssh_connection_SUITE \ ssh_protocol_SUITE \ ssh_sftp_SUITE \ @@ -129,7 +128,7 @@ release_spec: opt release_tests_spec: opt $(INSTALL_DIR) "$(RELSYSDIR)" $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)" - $(INSTALL_DATA) ssh.spec ssh.cover "$(RELSYSDIR)" + $(INSTALL_DATA) ssh.spec ssh_bench.spec ssh.cover "$(RELSYSDIR)" $(INSTALL_DATA) $(HRL_FILES_NEEDED_IN_TEST) "$(RELSYSDIR)" chmod -R u+w "$(RELSYSDIR)" @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) diff --git a/lib/ssh/test/ssh.spec b/lib/ssh/test/ssh.spec index 8de0fe44e4..0076fc275e 100644 --- a/lib/ssh/test/ssh.spec +++ b/lib/ssh/test/ssh.spec @@ -1,7 +1,6 @@ {suites,"../ssh_test",all}. -{skip_cases,"../ssh_test",ssh_ssh_SUITE, - [ssh], - "Current implementation is timingdependent and\nhence will succeed/fail on a whim"}. -{skip_cases,"../ssh_test",ssh_ssh_SUITE, - [ssh_compressed], - "Current implementation is timingdependent hence will succeed/fail on a whim"}. + +{skip_suites, "../ssh_test", [ssh_benchmark_SUITE], + "Benchmarks run separately"}. + + diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl index 6c4c215b3d..4b53f6ec57 100644 --- a/lib/ssh/test/ssh_basic_SUITE.erl +++ b/lib/ssh/test/ssh_basic_SUITE.erl @@ -601,10 +601,14 @@ cli(Config) when is_list(Config) -> process_flag(trap_exit, true), SystemDir = filename:join(?config(priv_dir, Config), system), UserDir = ?config(priv_dir, Config), - + + TmpDir = filename:join(?config(priv_dir,Config), "tmp"), + ok = ssh_test_lib:del_dirs(TmpDir), + ok = file:make_dir(TmpDir), + {_Pid, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},{user_dir, UserDir}, {password, "morot"}, - {ssh_cli, {ssh_test_cli, [cli]}}, + {ssh_cli, {ssh_test_cli, [cli,TmpDir]}}, {subsystems, []}, {failfun, fun ssh_test_lib:failfun/2}]), ct:sleep(500), diff --git a/lib/ssh/test/ssh_bench.spec b/lib/ssh/test/ssh_bench.spec new file mode 100644 index 0000000000..029f0bd074 --- /dev/null +++ b/lib/ssh/test/ssh_bench.spec @@ -0,0 +1 @@ +{suites,"../ssh_test",[ssh_benchmark_SUITE]}. diff --git a/lib/ssh/test/ssh_benchmark_SUITE.erl b/lib/ssh/test/ssh_benchmark_SUITE.erl new file mode 100644 index 0000000000..e90bfa3d16 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE.erl @@ -0,0 +1,539 @@ +%%%------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(ssh_benchmark_SUITE). +-compile(export_all). + +-include_lib("common_test/include/ct_event.hrl"). +-include_lib("common_test/include/ct.hrl"). + +-include_lib("ssh/src/ssh.hrl"). +-include_lib("ssh/src/ssh_transport.hrl"). +-include_lib("ssh/src/ssh_connect.hrl"). +-include_lib("ssh/src/ssh_userauth.hrl"). + + +suite() -> [{ct_hooks,[{ts_install_cth,[{nodenames,2}]}]}]. +%%suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> [{group, opensshc_erld} +%% {group, erlc_opensshd} + ]. + +groups() -> + [{opensshc_erld, [{repeat, 3}], [openssh_client_shell, + openssh_client_sftp]} + ]. + + +init_per_suite(Config) -> + catch ssh:stop(), + catch crypto:stop(), + try + ok = crypto:start(), + report_client_algorithms(), + ok = ssh:start(), + {ok,TracerPid} = erlang_trace(), + [{tracer_pid,TracerPid} | init_sftp_dirs(Config)] + catch + C:E -> + {skip, io_lib:format("Couldn't start ~p:~p",[C,E])} + end. + +end_per_suite(_Config) -> + catch ssh:stop(), + catch crypto:stop(), + ok. + + + +init_per_group(opensshc_erld, Config) -> + case ssh_test_lib:ssh_type() of + openSSH -> + DataDir = ?config(data_dir, Config), + UserDir = ?config(priv_dir, Config), + ssh_test_lib:setup_dsa(DataDir, UserDir), + ssh_test_lib:setup_rsa(DataDir, UserDir), + ssh_test_lib:setup_ecdsa("256", DataDir, UserDir), + Common = ssh_test_lib:intersect_bi_dir( + ssh_test_lib:intersection(ssh:default_algorithms(), + ssh_test_lib:default_algorithms(sshc))), + [{c_kexs, ssh_test_lib:sshc(kex)}, + {c_ciphers, ssh_test_lib:sshc(cipher)}, + {common_algs, Common} + | Config]; + _ -> + {skip, "No OpenSsh client found"} + end; + +init_per_group(erlc_opensshd, _) -> + {skip, "Group erlc_opensshd not implemented"}; + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, _Config) -> + ok. + + +init_per_testcase(_Func, Conf) -> + Conf. + +end_per_testcase(_Func, _Conf) -> + ok. + + +init_sftp_dirs(Config) -> + UserDir = ?config(priv_dir, Config), + SrcDir = filename:join(UserDir, "sftp_src"), + ok = file:make_dir(SrcDir), + SrcFile = "big_data", + DstDir = filename:join(UserDir, "sftp_dst"), + ok = file:make_dir(DstDir), + N = 100 * 1024*1024, + ok = file:write_file(filename:join(SrcDir,SrcFile), crypto:rand_bytes(N)), + [{sftp_src_dir,SrcDir}, {sftp_dst_dir,DstDir}, {src_file,SrcFile}, {sftp_size,N} + | Config]. + +%%%================================================================ +openssh_client_shell(Config) -> + lists:foreach( + fun(PrefAlgs=[{kex,[Kex]}]) when Kex == 'diffie-hellman-group-exchange-sha256' -> + lists:foreach( + fun(Grp) -> + openssh_client_shell(Config, + [{preferred_algorithms, PrefAlgs}, + {dh_gex_groups, [Grp]} + ]) + end, moduli()); + (PrefAlgs) -> + openssh_client_shell(Config, + [{preferred_algorithms, PrefAlgs}]) + end, variants(kex,Config) ++ variants(cipher,Config) + ). + + +openssh_client_shell(Config, Options) -> + SystemDir = ?config(data_dir, Config), + UserDir = ?config(priv_dir, Config), + KnownHosts = filename:join(UserDir, "known_hosts"), + + {ok, TracerPid} = erlang_trace(), + {ServerPid, _Host, Port} = + ssh_test_lib:daemon([{system_dir, SystemDir}, + {public_key_alg, ssh_dsa}, + {failfun, fun ssh_test_lib:failfun/2} | + Options]), + ct:sleep(500), + + Data = lists:duplicate(100000, $a), + Cmd = lists:concat(["ssh -p ",Port, + " -o UserKnownHostsFile=", KnownHosts, + " -o \"StrictHostKeyChecking no\"", + " localhost '\"",Data,"\"'."]), +%% ct:pal("Cmd ="++Cmd), + + Parent = self(), + SlavePid = spawn(fun() -> + Parent ! {self(),os:cmd(Cmd)} + end), + receive + {SlavePid, _ClientResponse} -> +%% ct:pal("ClientResponse = ~p",[_ClientResponse]), + {ok, List} = get_trace_list(TracerPid), + Times = find_times(List, [accept_to_hello, kex, kex_to_auth, auth, to_prompt]), + Algs = find_algs(List), + ct:pal("Algorithms = ~p~n~nTimes = ~p",[Algs,Times]), + lists:foreach( + fun({Tag,Value,Unit}) -> + EventData = + case Tag of + {A,B} when A==encrypt ; A==decrypt -> + [{value, Value}, + {suite, ?MODULE}, + {name, mk_name(["Cipher ",A," ",B," [",Unit,"]"])} + ]; + kex -> + KexAlgStr = fmt_alg(Algs#alg.kex, List), + [{value, Value}, + {suite, ?MODULE}, + {name, mk_name(["Erl server kex ",KexAlgStr," [",Unit,"]"])} + ]; + _ when is_atom(Tag) -> + [{value, Value}, + {suite, ?MODULE}, + {name, mk_name(["Erl server ",Tag," [",Unit,"]"])} + ] + end, + ct:pal("ct_event:notify ~p",[EventData]), + ct_event:notify(#event{name = benchmark_data, + data = EventData}) + end, Times), + ssh:stop_daemon(ServerPid), + ok + after 10000 -> + ssh:stop_daemon(ServerPid), + exit(SlavePid, kill), + {fail, timeout} + end. + + +%%%================================================================ +openssh_client_sftp(Config) -> + lists:foreach( + fun(PrefAlgs) -> + openssh_client_sftp(Config, [{preferred_algorithms,PrefAlgs}]) + end, variants(cipher,Config)). + + +openssh_client_sftp(Config, Options) -> + SystemDir = ?config(data_dir, Config), + UserDir = ?config(priv_dir, Config), + SftpSrcDir = ?config(sftp_src_dir, Config), + SrcFile = ?config(src_file, Config), + SrcSize = ?config(sftp_size, Config), + KnownHosts = filename:join(UserDir, "known_hosts"), + + {ok, TracerPid} = erlang_trace(), + {ServerPid, _Host, Port} = + ssh_test_lib:daemon([{system_dir, SystemDir}, + {public_key_alg, ssh_dsa}, + {subsystems,[ssh_sftpd:subsystem_spec([%{cwd, SftpSrcDir}, + {root, SftpSrcDir}])]}, + {failfun, fun ssh_test_lib:failfun/2} + | Options]), + ct:sleep(500), + Cmd = lists:concat(["sftp", + " -b -", + " -P ",Port, + " -o UserKnownHostsFile=", KnownHosts, + " -o \"StrictHostKeyChecking no\"", + " localhost:",SrcFile + ]), +%% ct:pal("Cmd = ~p",[Cmd]), + + Parent = self(), + SlavePid = spawn(fun() -> + Parent ! {self(),os:cmd(Cmd)} + end), + receive + {SlavePid, _ClientResponse} -> + ct:pal("ClientResponse = ~p",[_ClientResponse]), + {ok, List} = get_trace_list(TracerPid), +%%ct:pal("List=~p",[List]), + Times = find_times(List, [channel_open_close]), + Algs = find_algs(List), + ct:pal("Algorithms = ~p~n~nTimes = ~p",[Algs,Times]), + lists:foreach( + fun({{A,B},Value,Unit}) when A==encrypt ; A==decrypt -> + Data = [{value, Value}, + {suite, ?MODULE}, + {name, mk_name(["Sftp Cipher ",A," ",B," [",Unit,"]"])} + ], + ct:pal("sftp ct_event:notify ~p",[Data]), + ct_event:notify(#event{name = benchmark_data, + data = Data}); + ({channel_open_close,Value,Unit}) -> + Cipher = fmt_alg(Algs#alg.encrypt, List), + Data = [{value, round( (1024*Value) / SrcSize )}, + {suite, ?MODULE}, + {name, mk_name(["Sftp transfer ",Cipher," [",Unit," per kbyte]"])} + ], + ct:pal("sftp ct_event:notify ~p",[Data]), + ct_event:notify(#event{name = benchmark_data, + data = Data}); + (_) -> + skip + end, Times), + ssh:stop_daemon(ServerPid), + ok + after 10000 -> + ssh:stop_daemon(ServerPid), + exit(SlavePid, kill), + {fail, timeout} + end. + +%%%================================================================ +variants(Tag, Config) -> + TagType = + case proplists:get_value(Tag, ssh:default_algorithms()) of + [{_,_}|_] -> one_way; + [A|_] when is_atom(A) -> two_way + end, + [ [{Tag,tag_value(TagType,Alg)}] + || Alg <- proplists:get_value(Tag, ?config(common_algs,Config)) + ]. + +tag_value(two_way, Alg) -> [Alg]; +tag_value(one_way, Alg) -> [{client2server,[Alg]}, + {server2client,[Alg]}]. + +%%%---------------------------------------------------------------- +fmt_alg(Alg, List) when is_atom(Alg) -> + fmt_alg(atom_to_list(Alg), List); +fmt_alg(Alg = "diffie-hellman-group-exchange-sha" ++ _, List) -> + try + integer_to_list(find_gex_size_string(List)) + of + GexSize -> lists:concat([Alg," ",GexSize]) + catch + _:_ -> Alg + end; +fmt_alg(Alg, _List) -> + Alg. + +%%%---------------------------------------------------------------- +mk_name(Name) -> [char(C) || C <- lists:concat(Name)]. + +char($-) -> $_; +char(C) -> C. + +%%%---------------------------------------------------------------- +find_times(L, Xs) -> + [find_time(X,L) || X <- Xs] ++ + function_algs_times_sizes([{ssh_transport,encrypt,2}, + {ssh_transport,decrypt,2}, + {ssh_message,decode,1}, + {ssh_message,encode,1}], L). + +-record(call, { + mfa, + pid, + t_call, + t_return, + args, + result + }). + +%%%---------------- +-define(send(M), fun(C=#call{mfa = {ssh_message,encode,1}, + args = [M]}) -> + C#call.t_return + end). + +-define(recv(M), fun(C=#call{mfa = {ssh_message,decode,1}, + result = M}) -> + C#call.t_call + end). + +find_time(accept_to_hello, L) -> + [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) -> + C#call.t_call + end, + fun(C=#call{mfa = {ssh_connection_handler,hello,_}, + args = [socket_control|_]}) -> + C#call.t_return + end + ], L, []), + {accept_to_hello, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(kex, L) -> + [T0,T1] = find([fun(C=#call{mfa = {ssh_connection_handler,hello,_}, + args = [socket_control|_]}) -> + C#call.t_call + end, + ?send(#ssh_msg_newkeys{}) + ], L, []), + {kex, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(kex_to_auth, L) -> + [T0,T1] = find([?send(#ssh_msg_newkeys{}), + ?recv(#ssh_msg_userauth_request{}) + ], L, []), + {kex_to_auth, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(auth, L) -> + [T0,T1] = find([?recv(#ssh_msg_userauth_request{}), + ?send(#ssh_msg_userauth_success{}) + ], L, []), + {auth, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(to_prompt, L) -> + [T0,T1] = find([fun(C=#call{mfa = {ssh_acceptor,handle_connection,5}}) -> + C#call.t_call + end, + ?recv(#ssh_msg_channel_request{request_type="env"}) + ], L, []), + {to_prompt, now2micro_sec(now_diff(T1,T0)), microsec}; +find_time(channel_open_close, L) -> + [T0,T1] = find([?recv(#ssh_msg_channel_request{request_type="subsystem"}), + ?send(#ssh_msg_channel_close{}) + ], L, []), + {channel_open_close, now2micro_sec(now_diff(T1,T0)), microsec}. + + + +find([F|Fs], [C|Cs], Acc) when is_function(F,1) -> + try + F(C) + of + T -> find(Fs, Cs, [T|Acc]) + catch + _:_ -> find([F|Fs], Cs, Acc) + end; +find([], _, Acc) -> + lists:reverse(Acc). + + +find_algs(L) -> + {value, #call{result={ok,Algs}}} = + lists:keysearch({ssh_transport,select_algorithm,3}, #call.mfa, L), + Algs. + +find_gex_size_string(L) -> + %% server + {value, #call{result={ok,{Size, _}}}} = + lists:keysearch({public_key,dh_gex_group,4}, #call.mfa, L), + Size. + +%%%---------------- +function_algs_times_sizes(EncDecs, L) -> + Raw = [begin + {Tag,Size} = function_ats_result(EncDec, C), + {Tag, Size, now2micro_sec(now_diff(T1,T0))} + end + || EncDec <- EncDecs, + C = #call{mfa = ED, + args = Args, %%[S,Data], + t_call = T0, + t_return = T1} <- L, + ED == EncDec + ], + [{Alg, round(1024*Time/Size), "microsec per kbyte"} % Microseconds per 1k bytes. + || {Alg,Size,Time} <- lists:foldl(fun increment/2, [], Raw)]. + +function_ats_result({ssh_transport,encrypt,2}, #call{args=[S,Data]}) -> + {{encrypt,S#ssh.encrypt}, size(Data)}; +function_ats_result({ssh_transport,decrypt,2}, #call{args=[S,Data]}) -> + {{decrypt,S#ssh.decrypt}, size(Data)}; +function_ats_result({ssh_message,encode,1}, #call{result=Data}) -> + {encode, size(Data)}; +function_ats_result({ssh_message,decode,1}, #call{args=[Data]}) -> + {decode, size(Data)}. + + +increment({Alg,Sz,T}, [{Alg,SumSz,SumT}|Acc]) -> + [{Alg,SumSz+Sz,SumT+T} | Acc]; +increment(Spec, [X|Acc]) -> + [X | increment(Spec,Acc)]; % Not so many Alg, 2 or 3 +increment({Alg,Sz,T},[]) -> + [{Alg,Sz,T}]. + +%%%---------------------------------------------------------------- +%%% +%%% API for the traceing +%%% +get_trace_list(TracerPid) -> + TracerPid ! {get_trace_list,self()}, + receive + {trace_list,L} -> {ok, pair_events(lists:reverse(L))} + after 5000 -> {error,no_reply} + end. + +erlang_trace() -> + TracerPid = spawn(fun trace_loop/0), + 0 = erlang:trace(new, true, [call,timestamp,{tracer,TracerPid}]), + [init_trace(MFA, tp(MFA)) + || MFA <- [{ssh_acceptor,handle_connection,5}, + {ssh_connection_handler,hello,2}, + {ssh_message,encode,1}, + {ssh_message,decode,1}, + {ssh_transport,select_algorithm,3}, + {ssh_transport,encrypt,2}, + {ssh_transport,decrypt,2}, + {ssh_message,encode,1}, + {ssh_message,decode,1}, + {public_key,dh_gex_group,4} % To find dh_gex group size + ]], + {ok, TracerPid}. + +tp({_M,_F,Arity}) -> + [{lists:duplicate(Arity,'_'), [], [{return_trace}]}]. + +%%%---------------------------------------------------------------- +init_trace(MFA = {Module,_,_}, TP) -> + case code:is_loaded(Module) of + false -> code:load_file(Module); + _ -> ok + end, + erlang:trace_pattern(MFA, TP, [local]). + + +trace_loop() -> + trace_loop([]). + +trace_loop(L) -> + receive + {get_trace_list, From} -> + From ! {trace_list, L}, + trace_loop(L); + Ev -> + trace_loop([Ev|L]) + end. + +pair_events(L) -> + pair_events(L, []). + +pair_events([{trace_ts,Pid,call,{M,F,Args},TS0} | L], Acc) -> + Arity = length(Args), + {ReturnValue,TS1} = find_return(Pid, {M,F,Arity}, L), + pair_events(L, [#call{mfa = {M,F,Arity}, + pid = Pid, + t_call = TS0, + t_return = TS1, + args = Args, + result = ReturnValue} | Acc]); +pair_events([_|L], Acc) -> + pair_events(L, Acc); +pair_events([], Acc) -> + lists:reverse(Acc). + + +find_return(Pid, MFA, + [{trace_ts, Pid, return_from, MFA, ReturnValue, TS}|_]) -> + {ReturnValue, TS}; +find_return(Pid, MFA, [_|L]) -> + find_return(Pid, MFA, L); +find_return(_, _, []) -> + {undefined, undefined}. + +%%%---------------------------------------------------------------- +report_client_algorithms() -> + try + ssh_test_lib:extract_algos( ssh_test_lib:default_algorithms(sshc) ) + of + ClientAlgs -> + ct:pal("The client supports:~n~p",[ClientAlgs]) + catch + Cls:Err -> + ct:pal("Testing client about algorithms failed:~n~p ~p",[Cls,Err]) + end. + +%%%---------------------------------------------------------------- + + +now2sec({A,B,C}) -> A*1000000 + B + C/1000000. + +now2micro_sec({A,B,C}) -> (A*1000000 + B)*1000000 + C. + +now_diff({A1,B1,C1}, {A0,B0,C0}) -> {A1-A0, B1-B0, C1-C0}. + +%%%================================================================ +moduli() -> + [{1023, 5, 16#CF973CD39DC7D62F2C45AAC5180491104C76E0FE5D80A10E6C06AE442F1F373167B0FCBC931F3C157B10A5557008FDE20D68051E6A4DB11CEE0B0749F76D7134B937A59DA998C42BC234A5C1A3CFCD70E624D253D7694076F7B1FD7B8D3427849C9377B3555796ACA58C69DFF542EEEC9859D3ADCE5CC88DF6F7817C9D182EB7}, + {2047, 5, 16#F7693FC11FDDEAA493D3BA36F1FFF9264AA9952209203192A88A697BE9D0E306E306A27430BD87AB9EE9DB4BC78C41950C2EB0E5E4C686E8B1BA6D6A2B1FE91EF40C5EA32C51018323E1D305FE637F35ACABDBFC40AD683F779570A76869EB90015A342B2D1F7C81602688081FCAAA8D623090258D9C5C729C8CDDC0C12CA2D561DD987DB79B6AD7A2A509EBC383BF223FD95BC5A2FCC26FB3F3A0DD3FDC1228E338D3290235A596F9465F7BF490974847E616229A9E60B8F4AA161C52F655843CCCAE8821B40C426B535DE087964778652BBD4EC601C0456AE7128B593FCC64402C891227AE6EE88CC839416FBF462B4852999C646BE0BED7D8CF2BE5E381EF}, + {4095, 2, 16#C8842271626E53546E0C712FA265713F2EE073C20A0723C96B6B182B1EAACC96233D4A199BD0E85F264078A513AD2454F284B8DF543D85019D1E70F2FF54BA43EFBC64AF465C170C3E376F5EC328F98E33E1ED8BED84FA097ABE584152B0E9827ED5CC2B1D4F5ECF2DC46F45C59816D02698EA26F319311E2B6973E83C37021CC8B416AEF653896A1764EE0CEE718A45E8B47CB960BD5907D0E843E8A8E7D4698363C3C3FB3ADC512368B72CAF16510C69052EA2AF51BE00BC8CA04DF1F00A00CC2CA4D74254A1E8738460FD244DDB446CB36554B0A24EEF3710E44DBCF39881E7D3F9AE223388084E7A49A3CB12612AE36416C0EB5628DF1477FEE4A5CF77CDC09AA0E2C989C0B7D1310AFA44B81DA79A65226C7EA510057991EABF9388DC5EA9F52FEA5D3B0872843F50878740794E523E9DC60E0EA1FC8746A7B2AA31FCA89AAA2FA907BED116C69D98F912DD5089BECF28577064225DE96FC214ED1794E7CCE8024F94036D915A123A464C951DA96A5ED7F286F205BEE71BDE2D133FD1891B31178FF25D31611A5B7839F0E68EAF0F8901A571E6917C580F31842A9F19C47E0638483B7947DDCD7864660AC2F8B2C430F1E7FC0F22FA51F96F0499332C5AD3FF9DC7F4332DD5BCCA820CC779B90C0F4C5F0CA52E96FAA187361753FBADC5C80D0492CD80A3EEA5D578772DA9FC1C0E10A0203098AF36D0ED2156BA7321EB}, + {6143, 5, 16#FD9E6B52785CD7BE64D396A599DA4B97CD0BB49183F932A97694D80CA553354DBC26E77B8A0EC002257AADDF6AD27819CE64A06416E4A80B6EA92F28EA8D5B96C774109EEE5816B4B18F84368D1B41864C11AA73D6881675D779B174F6B4E344303F3EFD11BD7DE468467242372FD00908F296F5A2B20E2684F9122D08A46D647B05E298F0BCDAB60468349CCA6DA1B9FEBBC69D256FB9A3F1980F68466364FCEF1C98C1405191A6737A3627BA7F7313A8A18FC0B8521BF3430B1C6805CB44BCEB39904DD30130D24B225B598ED83C5FD757B80189FD9D5C2F9596687C40BAB1C6ED6244944629849D074A4C33FB15DDB3F9760FC59C44BEBB0EC032177147F61789769DAAAE2123CE488F7ECF19BDA051925BA9ED11EAA72DF70C9ECC8F714B4C35728E6679E66A1B56CCAE0FBBD3F9EBF950D4D623ED78E77CC3AD604E91F304EA78CE876F036214BD6F1977BD04C9ADD707D7A3BCCE87AD5D5A11C95E7025B0EA9C649DCB37942A3970A4FB04C284E4DDB4DC90163353B98B1C254FFD28443353F17A87C02E0BDB9F05424CC44C86309F1D73706F039CDAAC3EDC1A64F38FB42707D351DB5360C2680ADC1CC8D1C4AD312ACC904382C26BE33DA0E61429A5940820356ED28586BEB629ED1521D12D25B4DA01926295F3DA504DC9F431B719AC63277BE675E6F6DD4F7499CA11A23744577D653941963E8DAB610F7F226DB52CE5C683F72AEED2B6CE35ED07C29410397A6F7F606477CCC0EDE18CD0D96A7863BC4606193A8799B5AC1EEE6AC5EE36AC3077EC8DAB30EE94434B45B78BC13D96F74D6C4056EAA528CD3C68D308344808819B12F2BFB95A5C1A7DEEE188BF139216DDB7D757D7A50D3C46CE18881D776D617DCFFAA62276045373AA4D9446D7570338F99C0CA8A08851B4F9D388B4C275D3F9B7BA25F235D4329F63F7457C2EB5C68CE2A96D19766F0ED8E19F66DF3C5E29A38795B2F92291BB6EAB6F70A7E89DC9691F28486E9CF87FF11D5DF2E6B030A30B5D476AD59A34EE7262712ED96CEF4A5CAC3F08B3563D44683F746DA094C9CDB34427AF8D8CC2AE1B23C3BEB637}, + {8191, 2, 16#DC61EF13E4F3FC10CC946EEABC33F83EFCB35E0F47E4EC25C1CCBB2C7B502B2EFB0691AA231C8476DD51BA73204E6EA10B1A970FE2CF14AF01E72E1AEA87519A91D00D1499189F94A6CDA9E29C05F11F17FE74A4919A710A2787E180744465DF81C62AA65662FDA46FA6175E8A31E5B29E66DED6701C8FC4217E91D733FE94380F046680967D4CEA7BAC8F3916CDF96AA2C474FAD9650F48403FD0B5B756D34667D36A07767FA33027AE55484D0F701C3CA16632F413A14E4B8645AFAF15B78978C19A7661EDC569BEC72394B1204B166A48FCD5F56BE29840C7794CA6D3440356F15858CDCA9B429C7EA92E17242893FDC8C9C63841A382C32F20CFAB121B4BCAFD7BF9EF07FBF7CDFFECA0CEF3A49C3E2B24FA836F3318435255655E1B281071F62D5E4CD63361299B7828F72936E3FEA9E8044562A6F6ADD5321187C3101E4669C6271598FE1A866C93FE2870A4CEB9254BA32A4719E439317EA42200A335B5CFFA7946A7D0F1BD1A69AA11288B73C71C80B77FE3707CB077DDDEA5CA36A449FAB230C9625A0B12F8275D3FF82F5DA380E7A3F11B6F155FE7E91AC960BD95D9B13F7423AB9B15CC3C4DC34EF296033F009468EA16A721AD659F56C18516025050749ABF05E6D3EBD9778142A530979291F46DAA399A86B7BCDF09CC3E6EEF101419762A306DB45AEFC96C64E83F28338D55905F6A387E0F515E580C3A9B35330E21C32198CDEE3AFB355967A098F635FCA7C49CB4E1E82464B2B390EF1F259E40B9A06235C0273F76284FE6BD534EF3AF7CB01A4A5252B8B94CADC2850B2E56D53F9A31D7C029DF967D0A30C05BC64E119BED6076818FABC8CDD93F3255693E14EFC1A740A5D63A5E847FFE87BAB1DDE0506E1762EA61EFA9F9756151ECCCADD91B98A961A901A2D8B01ABDDD29EC804E8C8D28214BBA26048F924CA66316696E51A49D02FF034D20E44914B1115339CAD3819E0CB1640F0084886FEDDE5E28C29DC48ED30A8C3D789734338F5A9DF42584326E536FD1CF30BC85B8DCBD6120D127C98FE4B3614074F13C2CA4854E6D794156C185C40EB3DA7619CE96ADAF0941BD5499848B034C2B11DFECC0BDFA81C594241F759EF53FC7CDE7F2DE4F23CF81A5A0B7D62E31DABB9198D40307F7824DD130B7D1B80E9B6D322FEEDB5ACE34944F0BFB7D016762A9B2E173BFDD69303766AFBAB45FAB75D05430B4A3515858C4B7F04E23414E4AD03842CB0A20D8FF4B59B7C852BA9A5BE982A8ADA5CB70C36CE2A4D2C31A7015C9F3275E43D192C1B2924424088907A057DA7F2D32A2149922AB2E33F2147D637A3508911CB3FEA5E1AAB4525BACF27B6DD7A3E0AFA978FC3A39DE8882FB22688C3CCC92B6E69ACB0BBF575AB3368E51A2F6A20C414C6F146727CC0045F29061E695D29F7C030CE6929EB3AD11A5CBD0CDEE37347869A3}]. diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa b/lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa new file mode 100644 index 0000000000..d306f8b26e --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBvAIBAAKBgQDfi2flSTZZofwT4yQT0NikX/LGNT7UPeB/XEWe/xovEYCElfaQ +APFixXvEgXwoojmZ5kiQRKzLM39wBP0jPERLbnZXfOOD0PDnw0haMh7dD7XKVMod +/EigVgHf/qBdM2M8yz1s/rRF7n1UpLSypziKjkzCm7JoSQ2zbWIPdmBIXwIVAMgP +kpr7Sq3O7sHdb8D601DRjoExAoGAMOQxDfB2Fd8ouz6G96f/UOzRMI/Kdv8kYYKW +JIGY+pRYrLPyYzUeJznwZreOJgrczAX+luHnKFWJ2Dnk5CyeXk67Wsr7pJ/4MBMD +OKeIS0S8qoSBN8+Krp79fgA+yS3IfqbkJLtLu4EBaCX4mKQIX4++k44d4U5lc8pt ++9hlEI8CgYEAznKxx9kyC6bVo7LUYKaGhofRFt0SYFc5PVmT2VUGRs1R6+6DPD+e +uEO6IhFct7JFSRbP9p0JD4Uk+3zlZF+XX6b2PsZkeV8f/02xlNGUSmEzCSiNg1AX +Cy/WusYhul0MncWCHMcOZB5rIvU/aP5EJJtn3xrRaz6u0SThF6AnT34CFQC63czE +ZU8w8Q+H7z0j+a+70x2iAw== +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256 b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256 new file mode 100644 index 0000000000..4b1eb12eaa --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256 @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIJfCaBKIIKhjbJl5F8BedqlXOQYDX5ba9Skypllmx/w+oAoGCCqGSM49 +AwEHoUQDQgAE49RbK2xQ/19ji3uDPM7uT4692LbwWF1TiaA9vUuebMGazoW/98br +N9xZu0L1AWwtEjs3kmJDTB7eJEGXnjUAcQ== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub new file mode 100644 index 0000000000..a0147e60fa --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBOPUWytsUP9fY4t7gzzO7k+Ovdi28FhdU4mgPb1LnmzBms6Fv/fG6zfcWbtC9QFsLRI7N5JiQ0we3iRBl541AHE= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384 b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384 new file mode 100644 index 0000000000..4e8aa40959 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384 @@ -0,0 +1,6 @@ +-----BEGIN EC PRIVATE KEY----- +MIGkAgEBBDCYXb6OSAZyXRfLXOtMo43za197Hdc/T0YKjgQQjwDt6rlRwqTh7v7S +PV2kXwNGdWigBwYFK4EEACKhZANiAARN2khlJUOOIiwsWHEALwDieeZR96qL4pUd +ci7aeGaczdUK5jOA9D9zmBZtSYTfO8Cr7ekVghDlcWAIJ/BXcswgQwSEQ6wyfaTF +8FYfyr4l3u9IirsnyaFzeIgeoNis8Gw= +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub new file mode 100644 index 0000000000..41e722e545 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBE3aSGUlQ44iLCxYcQAvAOJ55lH3qovilR1yLtp4ZpzN1QrmM4D0P3OYFm1JhN87wKvt6RWCEOVxYAgn8FdyzCBDBIRDrDJ9pMXwVh/KviXe70iKuyfJoXN4iB6g2KzwbA== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521 b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521 new file mode 100644 index 0000000000..7196f46e97 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521 @@ -0,0 +1,7 @@ +-----BEGIN EC PRIVATE KEY----- +MIHbAgEBBEFMadoz4ckEcClfqXa2tiUuYkJdDfwq+/iFQcpt8ESuEd26IY/vm47Q +9UzbPkO4ou8xkNsQ3WvCRQBBWtn5O2kUU6AHBgUrgQQAI6GBiQOBhgAEAde5BRu5 +01/jS0jRk212xsb2DxPrxNpgp6IMCV8TA4Eps+8bSqHB091nLiBcP422HXYfuCd7 +XDjSs8ihcmhp0hCRASLqZR9EzW9W/SOt876May1Huj5X+WSO6RLe7vPn9vmf7kHf +pip6m7M7qp2qGgQ3q2vRwS2K/O6156ohiOlmuuFs +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub new file mode 100644 index 0000000000..8f059120bc --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAHXuQUbudNf40tI0ZNtdsbG9g8T68TaYKeiDAlfEwOBKbPvG0qhwdPdZy4gXD+Nth12H7gne1w40rPIoXJoadIQkQEi6mUfRM1vVv0jrfO+jGstR7o+V/lkjukS3u7z5/b5n+5B36YqepuzO6qdqhoEN6tr0cEtivzuteeqIYjpZrrhbA== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa b/lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa new file mode 100644 index 0000000000..9d7e0dd5fb --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa @@ -0,0 +1,15 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXAIBAAKBgQD1OET+3O/Bvj/dtjxDTXmj1oiJt4sIph5kGy0RfjoPrZfaS+CU +DhakCmS6t2ivxWFgtpKWaoGMZMJqWj6F6ZsumyFl3FPBtujwY/35cgifrI9Ns4Tl +zR1uuengNBmV+WRQ5cd9F2qS6Z8aDQihzt0r8JUqLcK+VQbrmNzboCCQQwIDAQAB +AoGAPQEyqPTt8JUT7mRXuaacjFXiweAXhp9NEDpyi9eLOjtFe9lElZCrsUOkq47V +TGUeRKEm9qSodfTbKPoqc8YaBJGJPhUaTAcha+7QcDdfHBvIsgxvU7ePVnlpXRp3 +CCUEMPhlnx6xBoTYP+fRU0e3+xJIPVyVCqX1jAdUMkzfRoECQQD6ux7B1QJAIWyK +SGkbDUbBilNmzCFNgIpOP6PA+bwfi5d16diTpra5AX09keQABAo/KaP1PdV8Vg0p +z4P3A7G3AkEA+l+AKG6m0kQTTBMJDqOdVPYwe+5GxunMaqmhokpEbuGsrZBl5Dvd +WpcBjR7jmenrhKZRIuA+Fz5HPo/UQJPl1QJBAKxstDkeED8j/S2XoFhPKAJ+6t39 +sUVICVTIZQeXdmzHJXCcUSkw8+WEhakqw/3SyW0oaK2FSWQJFWJUZ+8eJj8CQEh3 +xeduB5kKnS9CvzdeghZqX6QvVosSdtlUmfUYW/BgH5PpHKTP8wTaeld3XldZTpMJ +dKiMkUw2+XYROVUrubUCQD+Na1LhULlpn4ISEtIEfqpdlUhxDgO15Wg8USmsng+x +ICliVOSQtwaZjm8kwaFt0W7XnpnDxbRs37vIEbIMWak= +-----END RSA PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key new file mode 100644 index 0000000000..51ab6fbd88 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key @@ -0,0 +1,13 @@ +-----BEGIN DSA PRIVATE KEY----- +MIIBuwIBAAKBgQCClaHzE2ul0gKSUxah5W0W8UiJLy4hXngKEqpaUq9SSdVdY2LK +wVfKH1gt5iuaf1FfzOhsIC9G/GLnjYttXZc92cv/Gfe3gR+s0ni2++MX+T++mE/Q +diltXv/Hp27PybS67SmiFW7I+RWnT2OKlMPtw2oUuKeztCe5UWjaj/y5FQIVAPLA +l9RpiU30Z87NRAHY3NTRaqtrAoGANMRxw8UfdtNVR0CrQj3AgPaXOGE4d+G4Gp4X +skvnCHycSVAjtYxebUkzUzt5Q6f/IabuLUdge3gXrc8BetvrcKbp+XZgM0/Vj2CF +Ymmy3in6kzGZq7Fw1sZaku6AOU8vLa5woBT2vAcHLLT1bLAzj7viL048T6MfjrOP +ef8nHvACgYBhDWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah +/XcF3DeRF+eEoz48wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+U +ykSTXYUbtsfTNRFQGBW2/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0CgIVAN4wtL5W +Lv62jKcdskxNyz2NQoBx +-----END DSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub new file mode 100644 index 0000000000..4dbb1305b0 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub @@ -0,0 +1,11 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1kc3MAAACBAIKVofMTa6XSApJTFqHlbRbxSIkvLiFeeAoSqlpSr1JJ1V1j +YsrBV8ofWC3mK5p/UV/M6GwgL0b8YueNi21dlz3Zy/8Z97eBH6zSeLb74xf5P76YT9B2 +KW1e/8enbs/JtLrtKaIVbsj5FadPY4qUw+3DahS4p7O0J7lRaNqP/LkVAAAAFQDywJfU +aYlN9GfOzUQB2NzU0WqrawAAAIA0xHHDxR9201VHQKtCPcCA9pc4YTh34bganheyS+cI +fJxJUCO1jF5tSTNTO3lDp/8hpu4tR2B7eBetzwF62+twpun5dmAzT9WPYIViabLeKfqT +MZmrsXDWxlqS7oA5Ty8trnCgFPa8BwcstPVssDOPu+IvTjxPox+Os495/yce8AAAAIBh +DWFQJ1mf99sg92LalVq1dHLmVXb3PTJDfCO/Gz5NFmj9EZbAtdah/XcF3DeRF+eEoz48 +wQF/ExVxSMIhLdL+o+ElpVhlM7Yii+T7dPhkQfEul6zZXu+UykSTXYUbtsfTNRFQGBW2 +/GfnEc0mnIxfn9v10NEWMzlq5z9wT9P0Cg== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256 b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256 new file mode 100644 index 0000000000..2979ea88ed --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256 @@ -0,0 +1,5 @@ +-----BEGIN EC PRIVATE KEY----- +MHcCAQEEIMe4MDoit0t8RzSVPwkCBemQ9fhXL+xnTSAWISw8HNCioAoGCCqGSM49 +AwEHoUQDQgAEo2q7U3P6r0W5WGOLtM78UQtofM9UalEhiZeDdiyylsR/RR17Op0s +VPGSADLmzzgcucLEKy17j2S+oz42VUJy5A== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub new file mode 100644 index 0000000000..85dc419345 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBKNqu1Nz+q9FuVhji7TO/FELaHzPVGpRIYmXg3YsspbEf0UdezqdLFTxkgAy5s84HLnCxCste49kvqM+NlVCcuQ= uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384 b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384 new file mode 100644 index 0000000000..fb1a862ded --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384 @@ -0,0 +1,6 @@ +-----BEGIN EC PRIVATE KEY----- +MIGkAgEBBDArxbDfh3p1okrD9wQw6jJ4d4DdlBPD5GqXE8bIeRJiK41Sh40LgvPw +mkqEDSXK++CgBwYFK4EEACKhZANiAAScl43Ih2lWTDKrSox5ve5uiTXil4smsup3 +CfS1XPjKxgBAmlfBim8izbdrT0BFdQzz2joduNMtpt61wO4rGs6jm0UP7Kim9PC7 +Hneb/99fIYopdMH5NMnk60zGO1uZ2vc= +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub new file mode 100644 index 0000000000..428d5fb7d7 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp384 AAAAE2VjZHNhLXNoYTItbmlzdHAzODQAAAAIbmlzdHAzODQAAABhBJyXjciHaVZMMqtKjHm97m6JNeKXiyay6ncJ9LVc+MrGAECaV8GKbyLNt2tPQEV1DPPaOh240y2m3rXA7isazqObRQ/sqKb08Lsed5v/318hiil0wfk0yeTrTMY7W5na9w== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521 b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521 new file mode 100644 index 0000000000..3e51ec2ecd --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521 @@ -0,0 +1,7 @@ +-----BEGIN EC PRIVATE KEY----- +MIHcAgEBBEIB8O1BFkl2HQjQLRLonEZ97da/h39DMa9/0/hvPZWAI8gUPEQcHxRx +U7b09p3Zh+EBbMFq8+1ae9ds+ZTxE4WFSvKgBwYFK4EEACOhgYkDgYYABAAlWVjq +Bzg7Wt4gE6UNb1lRE2cnlmH2L/A5uo6qZRx5lPnSKOxEhxSb/Oay1+9d6KRdrh6/ +vlhd9SHDBhLcAPDvWgBnJIEj92Q3pXX4JtoitL0yl+SvvU+vUh966mzHShHzj8p5 +ccOgPkPNoA70yrpGzkIhPezpZOQdCaOXj/jFqNCTDg== +-----END EC PRIVATE KEY----- diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub new file mode 100644 index 0000000000..017a29f4da --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub @@ -0,0 +1 @@ +ecdsa-sha2-nistp521 AAAAE2VjZHNhLXNoYTItbmlzdHA1MjEAAAAIbmlzdHA1MjEAAACFBAAlWVjqBzg7Wt4gE6UNb1lRE2cnlmH2L/A5uo6qZRx5lPnSKOxEhxSb/Oay1+9d6KRdrh6/vlhd9SHDBhLcAPDvWgBnJIEj92Q3pXX4JtoitL0yl+SvvU+vUh966mzHShHzj8p5ccOgPkPNoA70yrpGzkIhPezpZOQdCaOXj/jFqNCTDg== uabhnil@elxadlj3q32 diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key new file mode 100644 index 0000000000..79968bdd7d --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key @@ -0,0 +1,16 @@ +-----BEGIN RSA PRIVATE KEY----- +MIICXQIBAAKBgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8semM4q843337 +zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RWRWzjaxSB +6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4QIDAQAB +AoGANmvJzJO5hkLuvyDZHKfAnGTtpifcR1wtSa9DjdKUyn8vhKF0mIimnbnYQEmW +NUUb3gXCZLi9PvkpRSVRrASDOZwcjoU/Kvww163vBUVb2cOZfFhyn6o2Sk88Tt++ +udH3hdjpf9i7jTtUkUe+QYPsia+wgvvrmn4QrahLAH86+kECQQDx5gFeXTME3cnW +WMpFz3PPumduzjqgqMMWEccX4FtQkMX/gyGa5UC7OHFyh0N/gSWvPbRHa8A6YgIt +n8DO+fh5AkEAzbqX4DOn8NY6xJIi42q7l/2jIA0RkB6P7YugW5NblhqBZ0XDnpA5 +sMt+rz+K07u9XZtxgh1xi7mNfwY6lEAMqQJBAJBEauCKmRj35Z6OyeQku59SPsnY ++SJEREVvSNw2lH9SOKQQ4wPsYlTGbvKtNVZgAcen91L5MmYfeckYE/fdIZECQQCt +64zxsTnM1I8iFxj/gP/OYlJBikrKt8udWmjaghzvLMEw+T2DExJyb9ZNeT53+UMB +m6O+B/4xzU/djvp+0hbhAkAemIt+rA5kTmYlFndhpvzkSSM8a2EXsO4XIPgGWCTT +tQKS/tTly0ADMjN/TVy11+9d6zcqadNVuHXHGtR4W0GR +-----END RSA PRIVATE KEY----- + diff --git a/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub new file mode 100644 index 0000000000..75d2025c71 --- /dev/null +++ b/lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub @@ -0,0 +1,5 @@ +---- BEGIN SSH2 PUBLIC KEY ---- +AAAAB3NzaC1yc2EAAAADAQABAAAAgQDCZX+4FBDwZIh9y/Uxee1VJnEXlowpz2yDKwj8 +semM4q843337zbNfxHmladB1lpz2NqyxI175xMIJuDxogyZdsOxGnFAzAnthR4dqL/RW +RWzjaxSB6IAO9SPYVVlrpZ+1hsjLW79fwXK/yc8VdhRuWTeQiRgYY2ek8+OKbOqz4Q== +---- END SSH2 PUBLIC KEY ---- diff --git a/lib/ssh/test/ssh_protocol_SUITE.erl b/lib/ssh/test/ssh_protocol_SUITE.erl index 5af60adfae..fe197f8672 100644 --- a/lib/ssh/test/ssh_protocol_SUITE.erl +++ b/lib/ssh/test/ssh_protocol_SUITE.erl @@ -48,6 +48,7 @@ all() -> [{group,tool_tests}, {group,kex}, {group,service_requests}, + {group,authentication}, {group,packet_size_error}, {group,field_size_error} ]. @@ -78,7 +79,9 @@ groups() -> bad_very_long_service_name, empty_service_name, bad_service_name_then_correct - ]} + ]}, + {authentication, [], [client_handles_keyboard_interactive_0_pwds + ]} ]. @@ -277,12 +280,7 @@ no_common_alg_server_disconnects(Config) -> {send, hello}, {match, #ssh_msg_kexinit{_='_'}, receive_msg}, {send, ssh_msg_kexinit}, % with server unsupported 'ssh-dss' ! - {match, - {'or',[#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, _='_'}, - tcp_closed, - {tcp_error,econnaborted} - ]}, - receive_msg} + {match, disconnect(), receive_msg} ] ). @@ -323,10 +321,7 @@ no_common_alg_client_disconnects(Config) -> first_kex_packet_follows = false, reserved = 0 }}, - {match, - {'or',[#ssh_msg_disconnect{code = ?SSH_DISCONNECT_KEY_EXCHANGE_FAILED, _='_'}, - tcp_closed]}, - receive_msg} + {match, disconnect(?SSH_DISCONNECT_KEY_EXCHANGE_FAILED), receive_msg} ], InitialState) } @@ -437,10 +432,7 @@ bad_service_name_then_correct(Config) -> [{set_options, [print_ops, print_seqnums, print_messages]}, {send, #ssh_msg_service_request{name = "kdjglkfdjgkldfjglkdfjglkfdjglkj"}}, {send, #ssh_msg_service_request{name = "ssh-connection"}}, - {match, {'or',[#ssh_msg_disconnect{_='_'}, - tcp_closed - ]}, - receive_msg} + {match, disconnect(), receive_msg} ], InitialState). @@ -450,10 +442,7 @@ bad_service_name(Config, Name) -> ssh_trpt_test_lib:exec( [{set_options, [print_ops, print_seqnums, print_messages]}, {send, #ssh_msg_service_request{name = Name}}, - {match, {'or',[#ssh_msg_disconnect{_='_'}, - tcp_closed - ]}, - receive_msg} + {match, disconnect(), receive_msg} ], InitialState). %%%-------------------------------------------------------------------- @@ -476,11 +465,7 @@ bad_packet_length(Config, LengthExcess) -> PacketFun}}, %% Prohibit remote decoder starvation: {send, #ssh_msg_service_request{name="ssh-userauth"}}, - {match, {'or',[#ssh_msg_disconnect{_='_'}, - tcp_closed, - {tcp_error,econnaborted} - ]}, - receive_msg} + {match, disconnect(), receive_msg} ], InitialState). %%%-------------------------------------------------------------------- @@ -509,13 +494,85 @@ bad_service_name_length(Config, LengthExcess) -> PacketFun} }, %% Prohibit remote decoder starvation: {send, #ssh_msg_service_request{name="ssh-userauth"}}, - {match, {'or',[#ssh_msg_disconnect{_='_'}, - tcp_closed, - {tcp_error,econnaborted} - ]}, - receive_msg} + {match, disconnect(), receive_msg} ], InitialState). +%%%-------------------------------------------------------------------- +%%% This is due to a fault report (OTP-13255) with OpenSSH-6.6.1 +client_handles_keyboard_interactive_0_pwds(Config) -> + {User,_Pwd} = server_user_password(Config), + + %% Create a listening socket as server socket: + {ok,InitialState} = ssh_trpt_test_lib:exec(listen), + HostPort = ssh_trpt_test_lib:server_host_port(InitialState), + + %% Start a process handling one connection on the server side: + spawn_link( + fun() -> + {ok,_} = + ssh_trpt_test_lib:exec( + [{set_options, [print_ops, print_messages]}, + {accept, [{system_dir, system_dir(Config)}, + {user_dir, user_dir(Config)}]}, + receive_hello, + {send, hello}, + + {send, ssh_msg_kexinit}, + {match, #ssh_msg_kexinit{_='_'}, receive_msg}, + + {match, #ssh_msg_kexdh_init{_='_'}, receive_msg}, + {send, ssh_msg_kexdh_reply}, + + {send, #ssh_msg_newkeys{}}, + {match, #ssh_msg_newkeys{_='_'}, receive_msg}, + + {match, #ssh_msg_service_request{name="ssh-userauth"}, receive_msg}, + {send, #ssh_msg_service_accept{name="ssh-userauth"}}, + + {match, #ssh_msg_userauth_request{service="ssh-connection", + method="none", + user=User, + _='_'}, receive_msg}, + {send, #ssh_msg_userauth_failure{authentications = "keyboard-interactive", + partial_success = false}}, + + {match, #ssh_msg_userauth_request{service="ssh-connection", + method="keyboard-interactive", + user=User, + _='_'}, receive_msg}, + {send, #ssh_msg_userauth_info_request{name = "", + instruction = "", + language_tag = "", + num_prompts = 1, + data = <<0,0,0,10,80,97,115,115,119,111,114,100,58,32,0>> + }}, + {match, #ssh_msg_userauth_info_response{num_responses = 1, + _='_'}, receive_msg}, + + %% the next is strange, but openssh 6.6.1 does this and this is what this testcase is about + {send, #ssh_msg_userauth_info_request{name = "", + instruction = "", + language_tag = "", + num_prompts = 0, + data = <<>> + }}, + {match, #ssh_msg_userauth_info_response{num_responses = 0, + data = <<>>, + _='_'}, receive_msg}, + %% Here we know that the tested fault is fixed + {send, #ssh_msg_userauth_success{}}, + close_socket, + print_state + ], + InitialState) + end), + + %% and finally connect to it with a regular Erlang SSH client: + {ok,_} = std_connect(HostPort, Config, + [{preferred_algorithms,[{kex,['diffie-hellman-group1-sha1']}]}] + ). + + %%%================================================================ %%%==== Internal functions ======================================== %%%================================================================ @@ -644,3 +701,16 @@ connect_and_kex(Config, InitialState) -> {match, #ssh_msg_newkeys{_='_'}, receive_msg} ], InitialState). + +%%%---------------------------------------------------------------- + +%%% For matching peer disconnection +disconnect() -> + disconnect('_'). + +disconnect(Code) -> + {'or',[#ssh_msg_disconnect{code = Code, + _='_'}, + tcp_closed, + {tcp_error,econnaborted} + ]}. diff --git a/lib/ssh/test/ssh_test_cli.erl b/lib/ssh/test/ssh_test_cli.erl index cd9ad5f2ff..697ddb730d 100644 --- a/lib/ssh/test/ssh_test_cli.erl +++ b/lib/ssh/test/ssh_test_cli.erl @@ -4,20 +4,25 @@ -record(state, { type, + tmpdir, id, ref, port }). -init([Type]) -> - {ok, #state{type = Type}}. + +init([Type]) -> init([Type,"/tmp"]); + +init([Type,TmpDir]) -> + {ok, #state{type = Type, + tmpdir = TmpDir}}. handle_msg({ssh_channel_up, Id, Ref}, S) -> User = get_ssh_user(Ref), ok = ssh_connection:send(Ref, Id, << "\r\nYou are accessing a dummy, type \"q\" to exit\r\n\n" >>), - Port = run_portprog(User, S#state.type), + Port = run_portprog(User, S#state.type, S#state.tmpdir), {ok, S#state{port = Port, id = Id, ref = Ref}}; handle_msg({Port, {data, Data}}, S = #state{port = Port}) -> @@ -68,10 +73,10 @@ handle_ssh_msg({ssh_cm, _, {exit_signal, Id, _, _, _}}, terminate(_Why, _S) -> nop. -run_portprog(User, cli) -> +run_portprog(User, cli, TmpDir) -> Pty_bin = os:find_executable("cat"), open_port({spawn_executable, Pty_bin}, - [stream, {cd, "/tmp"}, {env, [{"USER", User}]}, + [stream, {cd, TmpDir}, {env, [{"USER", User}]}, {args, []}, binary, exit_status, use_stdio, stderr_to_stdout]). diff --git a/lib/ssh/test/ssh_test_lib.erl b/lib/ssh/test/ssh_test_lib.erl index ed76f4f795..2db55b97b4 100644 --- a/lib/ssh/test/ssh_test_lib.erl +++ b/lib/ssh/test/ssh_test_lib.erl @@ -541,7 +541,6 @@ default_algorithms(sshc, DaemonOptions) -> ct:fail("No server respons 2") end. - run_fake_ssh({ok,InitialState}) -> KexInitPattern = #ssh_msg_kexinit{ @@ -583,6 +582,40 @@ run_fake_ssh({ok,InitialState}) -> {server2client, to_atoms(CompS2C)}]}]. +%%%---------------------------------------------------------------- +extract_algos(Spec) -> + [{Tag,get_atoms(List)} || {Tag,List} <- Spec]. + +get_atoms(L) -> + lists:usort( + [ A || X <- L, + A <- case X of + {_,L1} when is_list(L1) -> L1; + Y when is_atom(Y) -> [Y] + end]). + + +intersection(AlgoSpec1, AlgoSpec2) -> intersect(sort_spec(AlgoSpec1), sort_spec(AlgoSpec2)). + +intersect([{Tag,S1}|Ss1], [{Tag,S2}|Ss2]) -> + [{Tag,intersect(S1,S2)} | intersect(Ss1,Ss2)]; +intersect(L1=[A1|_], L2=[A2|_]) when is_atom(A1),is_atom(A2) -> + Diff = L1 -- L2, + L1 -- Diff; +intersect(_, _) -> + []. + +intersect_bi_dir([{Tag,[{client2server,L1},{server2client,L2}]}|T]) -> + [{Tag,intersect(L1,L2)} | intersect_bi_dir(T)]; +intersect_bi_dir([H={_,[A|_]}|T]) when is_atom(A) -> + [H | intersect_bi_dir(T)]; +intersect_bi_dir([]) -> + []. + + +sort_spec(L = [{_,_}|_] ) -> [{Tag,sort_spec(Es)} || {Tag,Es} <- L]; +sort_spec(L) -> lists:usort(L). + %%-------------------------------------------------------------------- sshc(Tag) -> to_atoms( diff --git a/lib/ssh/test/ssh_to_openssh_SUITE.erl b/lib/ssh/test/ssh_to_openssh_SUITE.erl index 02cc79e4d5..67a61d3c11 100644 --- a/lib/ssh/test/ssh_to_openssh_SUITE.erl +++ b/lib/ssh/test/ssh_to_openssh_SUITE.erl @@ -110,9 +110,9 @@ end_per_testcase(_TestCase, _Config) -> chk_key(Pgm, Name, File, Config) -> case ssh_test_lib:openssh_supports(Pgm, public_key, Name) of - true -> - {skip,lists:concat(["openssh client does not support ",Name])}; false -> + {skip,lists:concat(["openssh client does not support ",Name])}; + true -> {ok,[[Home]]} = init:get_argument(home), KeyFile = filename:join(Home, File), case file:read_file(KeyFile) of diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 25b19133b1..55d12abffe 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 4.2 +SSH_VSN = 4.2.1 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index bf87644116..aaf03d1cd8 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -221,7 +221,7 @@ <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>. By default <c>secure_renegotiate</c> is set to <c>false</c>, that is, secure renegotiation is used if possible, - but it fallback to unsecure renegotiation if the peer + but it falls back to insecure renegotiation if the peer does not support <url href="http://www.ietf.org/rfc/rfc5746.txt">RFC 5746</url>.</p> </item> @@ -307,7 +307,7 @@ atom()}} | <tag><c>unknown_ca</c></tag> <item><p>No trusted CA was found in the trusted store. The trusted CA is normally a so called ROOT CA, which is a self-signed certificate. Trust can - be claimed for an intermediat CA (trusted anchor does not have to be + be claimed for an intermediate CA (trusted anchor does not have to be self-signed according to X-509) by using option <c>partial_chain</c>.</p> </item> @@ -352,7 +352,7 @@ marker="public_key:public_key#pkix_path_validation-3">public_key:pkix_path_valid <tag><c>{http, timeout()}</c></tag> <item><p> Enables fetching of CRLs specified as http URIs in<seealso - marker="public_key:public_key_records"> X509 cerificate extensions.</seealso> + marker="public_key:public_key_records"> X509 certificate extensions.</seealso> Requires the OTP inets application.</p> </item> </taglist> @@ -611,14 +611,14 @@ fun(srp, Username :: string(), UserState :: term()) -> <tag><c>{sni_hosts, [{hostname(), ssloptions()}]}</c></tag> <item><p>If the server receives a SNI (Server Name Indication) from the client - matching a host listed in the <c>sni_hosts</c> option, the speicific options for + matching a host listed in the <c>sni_hosts</c> option, the specific options for that host will override previously specified options. The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p></item> <tag><c>{sni_fun, SNIfun::fun()}</c></tag> <item><p>If the server receives a SNI (Server Name Indication) from the client, - the given function will be called to retrive <c>ssloptions()</c> for indicated server. + the given function will be called to retrieve <c>ssloptions()</c> for the indicated server. These options will be merged into predefined <c>ssloptions()</c>. The function should be defined as: @@ -632,7 +632,7 @@ fun(srp, Username :: string(), UserState :: term()) -> of resources of such an operation is higher for the server than the client. This can act as a vector for denial of service attacks. The SSL application already takes measures to counter-act such attempts, - but client-initiated renegotiation can be stricly disabled by setting + but client-initiated renegotiation can be strictly disabled by setting this option to <c>false</c>. The default value is <c>true</c>. Note that disabling renegotiation can result in long-lived connections becoming unusable due to limits on the number of messages the underlying @@ -748,10 +748,10 @@ fun(srp, Username :: string(), UserState :: term()) -> <v>How = timeout() | {NewController::pid(), timeout()} </v> <v>Reason = term()</v> </type> - <desc><p>Closes or downgrades an SSL connection, in the later case the transport - connection will be handed over to the <c>NewController</c> process after reciving - the TLS close alert from the peer. The retuned transport socket will have - the following options set [{active, false}, {packet, 0}, {mode, binary}].</p> + <desc><p>Closes or downgrades an SSL connection. In the latter case the transport + connection will be handed over to the <c>NewController</c> process after receiving + the TLS close alert from the peer. The returned transport socket will have + the following options set: <c>[{active, false}, {packet, 0}, {mode, binary}]</c></p> </desc> </func> @@ -818,7 +818,7 @@ fun(srp, Username :: string(), UserState :: term()) -> <v>Reason = term()</v> </type> <desc><p>Returns the connection information you requested. The connection information you can request contains protocol, cipher_suite, and sni_hostname. - <c>{ok, Info}</c> will be returned if it executes sucessfully. The Info is a proplists containing the information you requested. + <c>{ok, Info}</c> will be returned if it executes successfully. <c>Info</c> is a proplist containing the information you requested. Otherwise, <c>{error, Reason}</c> will be returned.</p> </desc> </func> diff --git a/lib/ssl/src/inet_tls_dist.erl b/lib/ssl/src/inet_tls_dist.erl index 404ae93d20..6fe99a81c5 100644 --- a/lib/ssl/src/inet_tls_dist.erl +++ b/lib/ssl/src/inet_tls_dist.erl @@ -76,23 +76,23 @@ do_setup(Kernel, Node, Type, MyNode, LongOrShortNames, SetupTime) -> Timer, Version, Ip, TcpPort, Address, Type), dist_util:handshake_we_started(HSData); - _ -> + Other -> %% Other Node may have closed since %% port_please ! ?trace("other node (~p) " "closed since port_please.~n", [Node]), - ?shutdown(Node) + ?shutdown2(Node, {shutdown, {connect_failed, Other}}) end; - _ -> + Other -> ?trace("port_please (~p) " "failed.~n", [Node]), - ?shutdown(Node) + ?shutdown2(Node, {shutdown, {port_please_failed, Other}}) end; - _Other -> + Other -> ?trace("inet_getaddr(~p) " "failed (~p).~n", [Node,Other]), - ?shutdown(Node) + ?shutdown2(Node, {shutdown, {inet_getaddr_failed, Other}}) end. close(Socket) -> diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 11728128c4..057906bcb3 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,6 +1,9 @@ %% -*- erlang -*- {"%VSN%", [ + {<<"7\\.2">>, [{load_module, tls_connection, soft_purge, soft_purge, []}, + {load_module, ssl_tls_dist_proxy, soft_purge, soft_purge, []} + ]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, {<<"5\\..*">>, [{restart_application, ssl}]}, @@ -8,6 +11,9 @@ {<<"3\\..*">>, [{restart_application, ssl}]} ], [ + {<<"7\\.2">>, [{load_module, tls_connection, soft_purge, soft_purge, []}, + {load_module, ssl_tls_dist_proxy, soft_purge, soft_purge, []} + ]}, {<<"7\\..*">>, [{restart_application, ssl}]}, {<<"6\\..*">>, [{restart_application, ssl}]}, {<<"5\\..*">>, [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl index 4658e76ab1..e9dc5764a3 100644 --- a/lib/ssl/src/ssl_certificate.erl +++ b/lib/ssl/src/ssl_certificate.erl @@ -56,15 +56,15 @@ %% errors. Returns {RootCert, Path, VerifyErrors} %%-------------------------------------------------------------------- trusted_cert_and_path(CertChain, CertDbHandle, CertDbRef, PartialChainHandler) -> - Path = [Cert | _] = lists:reverse(CertChain), - OtpCert = public_key:pkix_decode_cert(Cert, otp), + Path = [BinCert | _] = lists:reverse(CertChain), + OtpCert = public_key:pkix_decode_cert(BinCert, otp), SignedAndIssuerID = case public_key:pkix_is_self_signed(OtpCert) of true -> {ok, IssuerId} = public_key:pkix_issuer_id(OtpCert, self), {self, IssuerId}; false -> - other_issuer(OtpCert, CertDbHandle) + other_issuer(OtpCert, BinCert, CertDbHandle) end, case SignedAndIssuerID of @@ -187,7 +187,7 @@ public_key_type(?'id-ecPublicKey') -> %%-------------------------------------------------------------------- %%% Internal functions %%-------------------------------------------------------------------- -certificate_chain(OtpCert, _Cert, CertDbHandle, CertsDbRef, Chain) -> +certificate_chain(OtpCert, BinCert, CertDbHandle, CertsDbRef, Chain) -> IssuerAndSelfSigned = case public_key:pkix_is_self_signed(OtpCert) of true -> @@ -200,7 +200,7 @@ certificate_chain(OtpCert, _Cert, CertDbHandle, CertsDbRef, Chain) -> {_, true = SelfSigned} -> certificate_chain(CertDbHandle, CertsDbRef, Chain, ignore, ignore, SelfSigned); {{error, issuer_not_found}, SelfSigned} -> - case find_issuer(OtpCert, CertDbHandle) of + case find_issuer(OtpCert, BinCert, CertDbHandle) of {ok, {SerialNr, Issuer}} -> certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, SelfSigned); @@ -232,12 +232,12 @@ certificate_chain(CertDbHandle, CertsDbRef, Chain, SerialNr, Issuer, _SelfSigned {ok, undefined, lists:reverse(Chain)} end. -find_issuer(OtpCert, CertDbHandle) -> +find_issuer(OtpCert, BinCert, CertDbHandle) -> IsIssuerFun = fun({_Key, {_Der, #'OTPCertificate'{} = ErlCertCandidate}}, Acc) -> case public_key:pkix_is_issuer(OtpCert, ErlCertCandidate) of true -> - case verify_cert_signer(OtpCert, ErlCertCandidate#'OTPCertificate'.tbsCertificate) of + case verify_cert_signer(BinCert, ErlCertCandidate#'OTPCertificate'.tbsCertificate) of true -> throw(public_key:pkix_issuer_id(ErlCertCandidate, self)); false -> @@ -265,9 +265,9 @@ is_valid_extkey_usage(KeyUse, server) -> %% Server wants to verify client is_valid_key_usage(KeyUse, ?'id-kp-clientAuth'). -verify_cert_signer(OtpCert, SignerTBSCert) -> +verify_cert_signer(BinCert, SignerTBSCert) -> PublicKey = public_key(SignerTBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo), - public_key:pkix_verify(public_key:pkix_encode('OTPCertificate', OtpCert, otp), PublicKey). + public_key:pkix_verify(BinCert, PublicKey). public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorithm = ?'id-ecPublicKey', parameters = Params}, @@ -281,12 +281,12 @@ public_key(#'OTPSubjectPublicKeyInfo'{algorithm = #'PublicKeyAlgorithm'{algorith subjectPublicKey = Key}) -> {Key, Params}. -other_issuer(OtpCert, CertDbHandle) -> +other_issuer(OtpCert, BinCert, CertDbHandle) -> case public_key:pkix_issuer_id(OtpCert, other) of {ok, IssuerId} -> {other, IssuerId}; {error, issuer_not_found} -> - case find_issuer(OtpCert, CertDbHandle) of + case find_issuer(OtpCert, BinCert, CertDbHandle) of {ok, IssuerId} -> {other, IssuerId}; Other -> diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl index 00e95f5c5b..311dac4619 100644 --- a/lib/ssl/src/ssl_manager.erl +++ b/lib/ssl/src/ssl_manager.erl @@ -263,7 +263,9 @@ init([Name, Opts]) -> session_cache_client_max = max_session_cache_size(session_cache_client_max), session_cache_server_max = - max_session_cache_size(session_cache_server_max) + max_session_cache_size(session_cache_server_max), + session_client_invalidator = undefined, + session_server_invalidator = undefined }}. %%-------------------------------------------------------------------- @@ -378,13 +380,17 @@ handle_cast({invalidate_pem, File}, handle_info(validate_sessions, #state{session_cache_cb = CacheCb, session_cache_client = ClientCache, session_cache_server = ServerCache, - session_lifetime = LifeTime + session_lifetime = LifeTime, + session_client_invalidator = Client, + session_server_invalidator = Server } = State) -> Timer = erlang:send_after(?SESSION_VALIDATION_INTERVAL, self(), validate_sessions), - start_session_validator(ClientCache, CacheCb, LifeTime), - start_session_validator(ServerCache, CacheCb, LifeTime), - {noreply, State#state{session_validation_timer = Timer}}; + CPid = start_session_validator(ClientCache, CacheCb, LifeTime, Client), + SPid = start_session_validator(ServerCache, CacheCb, LifeTime, Server), + {noreply, State#state{session_validation_timer = Timer, + session_client_invalidator = CPid, + session_server_invalidator = SPid}}; handle_info({delayed_clean_session, Key, Cache}, #state{session_cache_cb = CacheCb @@ -471,9 +477,11 @@ validate_session(Port, Session, LifeTime) -> invalidate_session(Port, Session) end. -start_session_validator(Cache, CacheCb, LifeTime) -> +start_session_validator(Cache, CacheCb, LifeTime, undefined) -> spawn_link(?MODULE, init_session_validator, - [[get(ssl_manager), Cache, CacheCb, LifeTime]]). + [[get(ssl_manager), Cache, CacheCb, LifeTime]]); +start_session_validator(_,_,_, Pid) -> + Pid. init_session_validator([SslManagerName, Cache, CacheCb, LifeTime]) -> put(ssl_manager, SslManagerName), @@ -708,6 +716,6 @@ crl_db_info(_, UserCRLDb) -> %% Only start a session invalidator if there is not %% one already active invalidate_session_cache(undefined, CacheCb, Cache) -> - start_session_validator(Cache, CacheCb, {invalidate_before, erlang:monotonic_time()}); + start_session_validator(Cache, CacheCb, {invalidate_before, erlang:monotonic_time()}, undefined); invalidate_session_cache(Pid, _CacheCb, _Cache) -> Pid. diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl index 75cfecdf5e..ce6b8fb84f 100644 --- a/lib/ssl/src/ssl_record.erl +++ b/lib/ssl/src/ssl_record.erl @@ -311,9 +311,19 @@ set_pending_cipher_state(#connection_states{pending_read = Read, %% %% Description: Encodes a handshake message to send on the ssl-socket. %%-------------------------------------------------------------------- -encode_handshake(Frag, Version, ConnectionStates) -> - encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates). - +encode_handshake(Frag, Version, + #connection_states{current_write = + #connection_state{ + security_parameters = + #security_parameters{bulk_cipher_algorithm = BCA}}} = + ConnectionStates) -> + case iolist_size(Frag) of + N when N > ?MAX_PLAIN_TEXT_LENGTH -> + Data = split_bin(iolist_to_binary(Frag), ?MAX_PLAIN_TEXT_LENGTH, Version, BCA), + encode_iolist(?HANDSHAKE, Data, Version, ConnectionStates); + _ -> + encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates) + end. %%-------------------------------------------------------------------- -spec encode_alert_record(#alert{}, ssl_version(), #connection_states{}) -> {iolist(), #connection_states{}}. diff --git a/lib/ssl/src/ssl_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl index d384264b53..211badef56 100644 --- a/lib/ssl/src/ssl_tls_dist_proxy.erl +++ b/lib/ssl/src/ssl_tls_dist_proxy.erl @@ -89,6 +89,14 @@ listen_options(Opts0) -> Opts1 end. +connect_options(Opts) -> + case application:get_env(kernel, inet_dist_connect_options) of + {ok,ConnectOpts} -> + lists:ukeysort(1, ConnectOpts ++ Opts); + _ -> + Opts + end. + %%==================================================================== %% gen_server callbacks %%==================================================================== @@ -101,7 +109,7 @@ init([]) -> {ok, #state{}}. handle_call({listen, Name}, _From, State) -> - case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}]) of + case gen_tcp:listen(0, [{active, false}, {packet,?PPRE}, {ip, loopback}]) of {ok, Socket} -> {ok, World} = do_listen([{active, false}, binary, {packet,?PPRE}, {reuseaddr, true}]), {ok, TcpAddress} = get_tcp_address(Socket), @@ -196,6 +204,7 @@ accept_loop(Proxy, world = Type, Listen, Extra) -> case gen_tcp:accept(Listen) of {ok, Socket} -> Opts = get_ssl_options(server), + wait_for_code_server(), case ssl:ssl_accept(Socket, Opts) of {ok, SslSocket} -> PairHandler = @@ -204,6 +213,11 @@ accept_loop(Proxy, world = Type, Listen, Extra) -> end), ok = ssl:controlling_process(SslSocket, PairHandler), flush_old_controller(PairHandler, SslSocket); + {error, {options, _}} = Error -> + %% Bad options: that's probably our fault. Let's log that. + error_logger:error_msg("Cannot accept TLS distribution connection: ~s~n", + [ssl:format_error(Error)]), + gen_tcp:close(Socket); _ -> gen_tcp:close(Socket) end; @@ -212,6 +226,35 @@ accept_loop(Proxy, world = Type, Listen, Extra) -> end, accept_loop(Proxy, Type, Listen, Extra). +wait_for_code_server() -> + %% This is an ugly hack. Upgrading a socket to TLS requires the + %% crypto module to be loaded. Loading the crypto module triggers + %% its on_load function, which calls code:priv_dir/1 to find the + %% directory where its NIF library is. However, distribution is + %% started earlier than the code server, so the code server is not + %% necessarily started yet, and code:priv_dir/1 might fail because + %% of that, if we receive an incoming connection on the + %% distribution port early enough. + %% + %% If the on_load function of a module fails, the module is + %% unloaded, and the function call that triggered loading it fails + %% with 'undef', which is rather confusing. + %% + %% Thus, the ssl_tls_dist_proxy process will terminate, and be + %% restarted by ssl_dist_sup. However, it won't have any memory + %% of being asked by net_kernel to listen for incoming + %% connections. Hence, the node will believe that it's open for + %% distribution, but it actually isn't. + %% + %% So let's avoid that by waiting for the code server to start. + case whereis(code_server) of + undefined -> + timer:sleep(10), + wait_for_code_server(); + Pid when is_pid(Pid) -> + ok + end. + try_connect(Port) -> case gen_tcp:connect({127,0,0,1}, Port, [{active, false}, {packet,?PPRE}, nodelay()]) of R = {ok, _S} -> @@ -222,10 +265,10 @@ try_connect(Port) -> setup_proxy(Ip, Port, Parent) -> process_flag(trap_exit, true), - Opts = get_ssl_options(client), + Opts = connect_options(get_ssl_options(client)), case ssl:connect(Ip, Port, [{active, true}, binary, {packet,?PPRE}, nodelay()] ++ Opts) of {ok, World} -> - {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, {127,0,0,1}}, binary, {packet,?PPRE}]), + {ok, ErtsL} = gen_tcp:listen(0, [{active, true}, {ip, loopback}, binary, {packet,?PPRE}]), {ok, #net_address{address={_,LPort}}} = get_tcp_address(ErtsL), Parent ! {self(), go_ahead, LPort}, case gen_tcp:accept(ErtsL) of @@ -235,6 +278,11 @@ setup_proxy(Ip, Port, Parent) -> Err -> Parent ! {self(), Err} end; + {error, {options, _}} = Err -> + %% Bad options: that's probably our fault. Let's log that. + error_logger:error_msg("Cannot open TLS distribution connection: ~s~n", + [ssl:format_error(Err)]), + Parent ! {self(), Err}; Err -> Parent ! {self(), Err} end. diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl index b2b85eaf8d..c3f0206d25 100644 --- a/lib/ssl/src/tls_connection.erl +++ b/lib/ssl/src/tls_connection.erl @@ -764,6 +764,8 @@ handle_tls_handshake(Handle, StateName, case Handle(Packet, FsmReturn) of {next_state, NextStateName, State, _Timeout} -> handle_tls_handshake(Handle, NextStateName, State); + {next_state, NextStateName, State} -> + handle_tls_handshake(Handle, NextStateName, State); {stop, _,_} = Stop -> Stop end; diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl index 8e909a5b74..f5cada9021 100644 --- a/lib/ssl/test/erl_make_certs.erl +++ b/lib/ssl/test/erl_make_certs.erl @@ -334,7 +334,9 @@ make_key(dsa, _Opts) -> gen_dsa2(128, 20); %% Bytes i.e. {1024, 160} make_key(ec, _Opts) -> %% (OBS: for testing only) - gen_ec2(secp256k1). + CurveOid = hd(tls_v1:ecc_curves(0)), + NamedCurve = pubkey_cert_records:namedCurves(CurveOid), + gen_ec2(NamedCurve). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% RSA key generation (OBS: for testing only) diff --git a/lib/ssl/test/ssl_certificate_verify_SUITE.erl b/lib/ssl/test/ssl_certificate_verify_SUITE.erl index 5940a86a7f..968ef30791 100644 --- a/lib/ssl/test/ssl_certificate_verify_SUITE.erl +++ b/lib/ssl/test/ssl_certificate_verify_SUITE.erl @@ -75,7 +75,8 @@ error_handling_tests()-> unknown_server_ca_accept_verify_none, unknown_server_ca_accept_verify_peer, unknown_server_ca_accept_backwardscompatibility, - no_authority_key_identifier]. + no_authority_key_identifier, + no_authority_key_identifier_and_nonstandard_encoding]. init_per_suite(Config0) -> catch crypto:stop(), @@ -850,6 +851,68 @@ delete_authority_key_extension([Head | Rest], Acc) -> %%-------------------------------------------------------------------- +no_authority_key_identifier_and_nonstandard_encoding() -> + [{doc, "Test cert with nonstandard encoding that does not have" + " authorityKeyIdentifier extension but are present in trusted certs db."}]. + +no_authority_key_identifier_and_nonstandard_encoding(Config) when is_list(Config) -> + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + PrivDir = ?config(priv_dir, Config), + + KeyFile = filename:join(PrivDir, "otpCA/private/key.pem"), + [KeyEntry] = ssl_test_lib:pem_to_der(KeyFile), + Key = ssl_test_lib:public_key(public_key:pem_entry_decode(KeyEntry)), + + CertFile = proplists:get_value(certfile, ServerOpts), + NewCertFile = filename:join(PrivDir, "server/new_cert.pem"), + [{'Certificate', DerCert, _}] = ssl_test_lib:pem_to_der(CertFile), + ServerCert = public_key:pkix_decode_cert(DerCert, plain), + ServerTbsCert = ServerCert#'Certificate'.tbsCertificate, + Extensions0 = ServerTbsCert#'TBSCertificate'.extensions, + %% need to remove authorityKeyIdentifier extension to cause DB lookup by signature + Extensions = delete_authority_key_extension(Extensions0, []), + NewExtensions = replace_key_usage_extension(Extensions, []), + NewServerTbsCert = ServerTbsCert#'TBSCertificate'{extensions = NewExtensions}, + + ct:log("Extensions ~p~n, NewExtensions: ~p~n", [Extensions, NewExtensions]), + + TbsDer = public_key:pkix_encode('TBSCertificate', NewServerTbsCert, plain), + Sig = public_key:sign(TbsDer, md5, Key), + NewServerCert = ServerCert#'Certificate'{tbsCertificate = NewServerTbsCert, signature = Sig}, + NewDerCert = public_key:pkix_encode('Certificate', NewServerCert, plain), + ssl_test_lib:der_to_pem(NewCertFile, [{'Certificate', NewDerCert, not_encrypted}]), + NewServerOpts = [{certfile, NewCertFile} | proplists:delete(certfile, ServerOpts)], + + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, + send_recv_result_active, []}}, + {options, [{active, true} | NewServerOpts]}]), + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, + send_recv_result_active, []}}, + {options, [{verify, verify_peer} | ClientOpts]}]), + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client). + +replace_key_usage_extension([], Acc) -> + lists:reverse(Acc); +replace_key_usage_extension([#'Extension'{extnID = ?'id-ce-keyUsage'} = E | Rest], Acc) -> + %% A nonstandard DER encoding of [digitalSignature, keyEncipherment] + Val = <<3, 2, 0, 16#A0>>, + replace_key_usage_extension(Rest, [E#'Extension'{extnValue = Val} | Acc]); +replace_key_usage_extension([Head | Rest], Acc) -> + replace_key_usage_extension(Rest, [Head | Acc]). + +%%-------------------------------------------------------------------- + invalid_signature_server() -> [{doc,"Test client with invalid signature"}]. diff --git a/lib/ssl/test/ssl_dist_SUITE.erl b/lib/ssl/test/ssl_dist_SUITE.erl index 092015d3d8..00f9ee8e3c 100644 --- a/lib/ssl/test/ssl_dist_SUITE.erl +++ b/lib/ssl/test/ssl_dist_SUITE.erl @@ -41,7 +41,7 @@ %%-------------------------------------------------------------------- all() -> [basic, payload, plain_options, plain_verify_options, nodelay_option, - listen_port_options, listen_options, use_interface]. + listen_port_options, listen_options, connect_options, use_interface]. groups() -> []. @@ -312,22 +312,7 @@ listen_port_options(Config) when is_list(Config) -> listen_options() -> [{doc, "Test inet_dist_listen_options"}]. listen_options(Config) when is_list(Config) -> - Prio = 1, - case gen_udp:open(0, [{priority,Prio}]) of - {ok,Socket} -> - case inet:getopts(Socket, [priority]) of - {ok,[{priority,Prio}]} -> - ok = gen_udp:close(Socket), - do_listen_options(Prio, Config); - _ -> - ok = gen_udp:close(Socket), - {skip, - "Can not set priority "++integer_to_list(Prio)++ - " on socket"} - end; - {error,_} -> - {skip, "Can not set priority on socket"} - end. + try_setting_priority(fun do_listen_options/2, Config). do_listen_options(Prio, Config) -> PriorityString0 = "[{priority,"++integer_to_list(Prio)++"}]", @@ -364,6 +349,48 @@ do_listen_options(Prio, Config) -> stop_ssl_node(NH2), success(Config). %%-------------------------------------------------------------------- +connect_options() -> + [{doc, "Test inet_dist_connect_options"}]. +connect_options(Config) when is_list(Config) -> + try_setting_priority(fun do_connect_options/2, Config). + +do_connect_options(Prio, Config) -> + PriorityString0 = "[{priority,"++integer_to_list(Prio)++"}]", + PriorityString = + case os:cmd("echo [{a,1}]") of + "[{a,1}]"++_ -> + PriorityString0; + _ -> + %% Some shells need quoting of [{}] + "'"++PriorityString0++"'" + end, + + Options = "-kernel inet_dist_connect_options " ++ PriorityString, + + NH1 = start_ssl_node([{additional_dist_opts, Options} | Config]), + NH2 = start_ssl_node([{additional_dist_opts, Options} | Config]), + Node2 = NH2#node_handle.nodename, + + pong = apply_on_ssl_node(NH1, fun () -> net_adm:ping(Node2) end), + + PrioritiesNode1 = + apply_on_ssl_node(NH1, fun get_socket_priorities/0), + PrioritiesNode2 = + apply_on_ssl_node(NH2, fun get_socket_priorities/0), + + Elevated1 = [P || P <- PrioritiesNode1, P =:= Prio], + ?t:format("Elevated1: ~p~n", [Elevated1]), + Elevated2 = [P || P <- PrioritiesNode2, P =:= Prio], + ?t:format("Elevated2: ~p~n", [Elevated2]), + %% Node 1 will have a socket with elevated priority. + [_|_] = Elevated1, + %% Node 2 will not, since it only applies to outbound connections. + [] = Elevated2, + + stop_ssl_node(NH1), + stop_ssl_node(NH2), + success(Config). +%%-------------------------------------------------------------------- use_interface() -> [{doc, "Test inet_dist_use_interface"}]. use_interface(Config) when is_list(Config) -> @@ -405,6 +432,24 @@ tstsrvr_format(Fmt, ArgList) -> send_to_tstcntrl(Message) -> send_to_tstsrvr({message, Message}). +try_setting_priority(TestFun, Config) -> + Prio = 1, + case gen_udp:open(0, [{priority,Prio}]) of + {ok,Socket} -> + case inet:getopts(Socket, [priority]) of + {ok,[{priority,Prio}]} -> + ok = gen_udp:close(Socket), + TestFun(Prio, Config); + _ -> + ok = gen_udp:close(Socket), + {skip, + "Can not set priority "++integer_to_list(Prio)++ + " on socket"} + end; + {error,_} -> + {skip, "Can not set priority on socket"} + end. + get_socket_priorities() -> [Priority || {ok,[{priority,Priority}]} <- @@ -493,17 +538,13 @@ host_name() -> Host. mk_node_name(Config) -> - {A, B, C} = erlang:now(), + N = erlang:unique_integer([positive]), Case = ?config(testcase, Config), atom_to_list(?MODULE) ++ "_" ++ atom_to_list(Case) ++ "_" - ++ integer_to_list(A) - ++ "-" - ++ integer_to_list(B) - ++ "-" - ++ integer_to_list(C). + ++ integer_to_list(N). mk_node_cmdline(ListenPort, Name, Args) -> Static = "-detached -noinput", @@ -732,12 +773,10 @@ rand_bin(N) -> rand_bin(0, Acc) -> Acc; rand_bin(N, Acc) -> - rand_bin(N-1, [random:uniform(256)-1|Acc]). + rand_bin(N-1, [rand:uniform(256)-1|Acc]). make_randfile(Dir) -> {ok, IoDev} = file:open(filename:join([Dir, "RAND"]), [write]), - {A, B, C} = erlang:now(), - random:seed(A, B, C), ok = file:write(IoDev, rand_bin(1024)), file:close(IoDev). diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl index 9a76d603b1..afd21f0d2f 100644 --- a/lib/ssl/test/ssl_test_lib.erl +++ b/lib/ssl/test/ssl_test_lib.erl @@ -818,7 +818,17 @@ rsa_suites(CounterPart) -> (_) -> false end, - ssl:cipher_suites()). + common_ciphers(CounterPart)). + +common_ciphers(crypto) -> + ssl:cipher_suites(); +common_ciphers(openssl) -> + OpenSslSuites = + string:tokens(string:strip(os:cmd("openssl ciphers"), right, $\n), ":"), + [ssl:suite_definition(S) + || S <- ssl_cipher:suites(tls_record:highest_protocol_version([])), + lists:member(ssl_cipher:openssl_suite_name(S), OpenSslSuites) + ]. rsa_non_signed_suites() -> lists:filter(fun({rsa, _, _}) -> @@ -1158,23 +1168,27 @@ cipher_restriction(Config0) -> end. check_sane_openssl_version(Version) -> - case {Version, os:cmd("openssl version")} of - {_, "OpenSSL 1.0.2" ++ _} -> - true; - {_, "OpenSSL 1.0.1" ++ _} -> - true; - {'tlsv1.2', "OpenSSL 1.0" ++ _} -> - false; - {'tlsv1.1', "OpenSSL 1.0" ++ _} -> - false; - {'tlsv1.2', "OpenSSL 0" ++ _} -> - false; - {'tlsv1.1', "OpenSSL 0" ++ _} -> - false; - {_, _} -> - true + case supports_ssl_tls_version(Version) of + true -> + case {Version, os:cmd("openssl version")} of + {_, "OpenSSL 1.0.2" ++ _} -> + true; + {_, "OpenSSL 1.0.1" ++ _} -> + true; + {'tlsv1.2', "OpenSSL 1.0" ++ _} -> + false; + {'tlsv1.1', "OpenSSL 1.0" ++ _} -> + false; + {'tlsv1.2', "OpenSSL 0" ++ _} -> + false; + {'tlsv1.1', "OpenSSL 0" ++ _} -> + false; + {_, _} -> + true + end; + false -> + false end. - enough_openssl_crl_support("OpenSSL 0." ++ _) -> false; enough_openssl_crl_support(_) -> true. @@ -1198,7 +1212,9 @@ version_flag('tlsv1.1') -> version_flag('tlsv1.2') -> "-tls1_2"; version_flag(sslv3) -> - "-ssl3". + "-ssl3"; +version_flag(sslv2) -> + "-ssl2". filter_suites(Ciphers0) -> Version = tls_record:highest_protocol_version([]), @@ -1249,3 +1265,25 @@ portable_open_port(Exe, Args) -> ct:pal("open_port({spawn_executable, ~p}, [{args, ~p}, stderr_to_stdout]).", [AbsPath, Args]), open_port({spawn_executable, AbsPath}, [{args, Args}, stderr_to_stdout]). + +supports_ssl_tls_version(Version) -> + VersionFlag = version_flag(Version), + Exe = "openssl", + Args = ["s_client", VersionFlag], + Port = ssl_test_lib:portable_open_port(Exe, Args), + do_supports_ssl_tls_version(Port). + +do_supports_ssl_tls_version(Port) -> + receive + {Port, {data, "unknown option" ++ _}} -> + false; + {Port, {data, Data}} -> + case lists:member("error", string:tokens(Data, ":")) of + true -> + false; + false -> + do_supports_ssl_tls_version(Port) + end + after 500 -> + true + end. diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index 13523730b0..ecf6c4d6b8 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -175,7 +175,12 @@ special_init(TestCase, Config) check_sane_openssl_renegotaite(Config, Version); special_init(ssl2_erlang_server_openssl_client, Config) -> - check_sane_openssl_sslv2(Config); + case ssl_test_lib:supports_ssl_tls_version(sslv2) of + true -> + Config; + false -> + {skip, "sslv2 not supported by openssl"} + end; special_init(TestCase, Config) when TestCase == erlang_client_alpn_openssl_server_alpn; @@ -1440,7 +1445,7 @@ start_erlang_client_and_openssl_server_for_alpn_negotiation(Config, Data, Callba Exe = "openssl", Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), - "-cert", CertFile, "-key" ++ KeyFile], + "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), ssl_test_lib:wait_for_openssl_server(Port), @@ -1475,7 +1480,7 @@ start_erlang_server_and_openssl_client_for_alpn_negotiation(Config, Data, Callba Version = tls_record:protocol_version(tls_record:highest_protocol_version([])), Exe = "openssl", - Args = ["s_client", "-alpn", "http/1.0,spdy/2" "-msg" "-port", + Args = ["s_client", "-alpn", "http/1.0,spdy/2", "-msg", "-port", integer_to_list(Port), ssl_test_lib:version_flag(Version), "-host", "localhost"], @@ -1507,7 +1512,7 @@ start_erlang_client_and_openssl_server_for_alpn_npn_negotiation(Config, Data, Ca Exe = "openssl", Args = ["s_server", "-msg", "-alpn", "http/1.1,spdy/2", "-nextprotoneg", "spdy/3", "-accept", integer_to_list(Port), ssl_test_lib:version_flag(Version), - "-cert" ++ CertFile ++ "-key" ++ KeyFile], + "-cert", CertFile, "-key", KeyFile], OpensslPort = ssl_test_lib:portable_open_port(Exe, Args), @@ -1756,32 +1761,6 @@ check_sane_openssl_renegotaite(Config) -> Config end. -check_sane_openssl_sslv2(Config) -> - Exe = "openssl", - Args = ["s_client", "-ssl2"], - Port = ssl_test_lib:portable_open_port(Exe, Args), - case supports_sslv2(Port) of - true -> - Config; - false -> - {skip, "sslv2 not supported by openssl"} - end. - -supports_sslv2(Port) -> - receive - {Port, {data, "unknown option -ssl2" ++ _}} -> - false; - {Port, {data, Data}} -> - case lists:member("error", string:tokens(Data, ":")) of - true -> - false; - false -> - supports_sslv2(Port) - end - after 500 -> - true - end. - workaround_openssl_s_clinent() -> %% http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=683159 %% https://bugs.archlinux.org/task/33919 diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index aa1af21990..9f79a7fb34 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 7.2 +SSL_VSN = 7.2.1 diff --git a/lib/stdlib/doc/src/dets.xml b/lib/stdlib/doc/src/dets.xml index a0d3f95b6a..48400733d1 100644 --- a/lib/stdlib/doc/src/dets.xml +++ b/lib/stdlib/doc/src/dets.xml @@ -399,15 +399,40 @@ kept in RAM.</p> </item> <item> - <p><c>{safe_fixed,</c> SafeFixed<c>}</c>. If the table - is fixed, SafeFixed is a tuple <c>{FixedAtTime, [{Pid,RefCount}]}</c>. <c>FixedAtTime</c> is the time when + <p><c>{safe_fixed_monotonic_time, SafeFixed}</c>. If the table + is fixed, <c>SafeFixed</c> is a tuple <c>{FixedAtTime, [{Pid,RefCount}]}</c>. + <c>FixedAtTime</c> is the time when the table was first fixed, and <c>Pid</c> is the pid of the process that fixes the table <c>RefCount</c> times. There may be any number of processes in the list. If the table is not fixed, SafeFixed is the atom <c>false</c>.</p> + <p><c>FixedAtTime</c> will correspond to the result + returned by + <seealso marker="erts:erlang#monotonic_time/0">erlang:monotonic_time/0</seealso> + at the time of fixation. The usage of <c>safe_fixed_monotonic_time</c> is + <seealso marker="erts:time_correction#Time_Warp_Safe_Code">time warp + safe</seealso>.</p> </item> <item> - <p><c>{version, integer()</c>, the version of the format of + <p> + <c>{safe_fixed, SafeFixed}</c>. The same as + <c>{safe_fixed_monotonic_time, SafeFixed}</c> with the exception + of the format and value of <c>FixedAtTime</c>. + </p> + <p> + <c>FixedAtTime</c> will correspond to the result returned by + <seealso marker="erts:erlang#timestamp/0">erlang:timestamp/0</seealso> + at the time of fixation. Note that when the system is using + single or multi + <seealso marker="erts:time_correction#Time_Warp_Modes">time warp + modes</seealso> this might produce strange results. This + since the usage of <c>safe_fixed</c> is not + <seealso marker="erts:time_correction#Time_Warp_Safe_Code">time warp + safe</seealso>. Time warp safe code need to use + <c>safe_fixed_monotonic_time</c> instead.</p> + </item> + <item> + <p><c>{version, integer()}</c>, the version of the format of the table.</p> </item> </list> diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml index 7b01109ff8..447fe51130 100644 --- a/lib/stdlib/doc/src/ets.xml +++ b/lib/stdlib/doc/src/ets.xml @@ -488,14 +488,39 @@ Error: fun containing local Erlang function calls <item><c>Item=fixed, Value=boolean()</c> <br></br> Indicates if the table is fixed by any process or not.</item> - <item> - <p><c>Item=safe_fixed, Value={FirstFixed,Info}|false</c> <br></br> + <item><marker id="info_2_safe_fixed_monotonic_time"/> + <p><c>Item=safe_fixed|safe_fixed_monotonic_time, Value={FixationTime,Info}|false</c> <br></br> </p> - <p>If the table has been fixed using <c>safe_fixtable/2</c>, - the call returns a tuple where <c>FirstFixed</c> is the + <p>If the table has been fixed using + <seealso marker="#safe_fixtable/2"><c>safe_fixtable/2</c></seealso>, + the call returns a tuple where <c>FixationTime</c> is the time when the table was first fixed by a process, which may or may not be one of the processes it is fixed by right now.</p> + <p>The format and value of <c>FixationTime</c> depends on + <c>Item</c>:</p> + <taglist> + <tag><c>safe_fixed</c></tag> + <item><p><c>FixationTime</c> will correspond to the result + returned by + <seealso marker="erts:erlang#timestamp/0">erlang:timestamp/0</seealso> + at the time of fixation. Note that when the system is using + single or multi + <seealso marker="erts:time_correction#Time_Warp_Modes">time warp + modes</seealso> this might produce strange results. This + since the usage of <c>safe_fixed</c> is not + <seealso marker="erts:time_correction#Time_Warp_Safe_Code">time warp + safe</seealso>. Time warp safe code need to use + <c>safe_fixed_monotonic_time</c> instead.</p></item> + + <tag><c>safe_fixed_monotonic_time</c></tag> + <item><p><c>FixationTime</c> will correspond to the result + returned by + <seealso marker="erts:erlang#monotonic_time/0">erlang:monotonic_time/0</seealso> + at the time of fixation. The usage of <c>safe_fixed_monotonic_time</c> is + <seealso marker="erts:time_correction#Time_Warp_Safe_Code">time warp + safe</seealso>.</p></item> + </taglist> <p><c>Info</c> is a possibly empty lists of tuples <c>{Pid,RefCount}</c>, one tuple for every process the table is fixed by right now. <c>RefCount</c> is the value @@ -1135,9 +1160,11 @@ clean_all_with_value(Tab,X,Key) -> table but never releases it, the memory used by the deleted objects will never be freed. The performance of operations on the table will also degrade significantly.</p> - <p>Use <c>info/2</c> to retrieve information about which - processes have fixed which tables. A system with a lot of - processes fixing tables may need a monitor which sends alarms + <p>Use + <seealso marker="#info_2_safe_fixed_monotonic_time"><c>info(Tab, + safe_fixed_monotonic_time)</c></seealso> to retrieve information + about which processes have fixed which tables. A system with a lot + of processes fixing tables may need a monitor which sends alarms when tables have been fixed for too long.</p> <p>Note that for tables of the <c>ordered_set</c> type, <c>safe_fixtable/2</c> is not necessary as calls to diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 24ff251ce3..815bf4a489 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -543,7 +543,10 @@ </item> <item> <p><c>active</c> - the count of all actively running child processes - managed by this supervisor.</p> + managed by this supervisor. In the case of <c>simple_one_for_one</c> + supervisors, no check is carried out to ensure that each child process + is still alive, though the result provided here is likely to be very + accurate unless the supervisor is heavily overloaded.</p> </item> <item> <p><c>supervisors</c> - the count of all children marked as diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index cbbab088f4..503a2b416f 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -931,7 +931,10 @@ call_crypto_server(Req) -> end. call_crypto_server_1(Req) -> - {ok, _} = gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []), + case gen_server:start({local,?CRYPTO_KEY_SERVER}, ?MODULE, [], []) of + {ok, _} -> ok; + {error, {already_started, _}} -> ok + end, erlang:yield(), call_crypto_server(Req). diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 6d07f4018a..2d037ff795 100644 --- a/lib/stdlib/src/dets.erl +++ b/lib/stdlib/src/dets.erl @@ -372,7 +372,7 @@ info(Tab) -> Item :: 'access' | 'auto_save' | 'bchunk_format' | 'hash' | 'file_size' | 'filename' | 'keypos' | 'memory' | 'no_keys' | 'no_objects' | 'no_slots' | 'owner' | 'ram_file' - | 'safe_fixed' | 'size' | 'type' | 'version', + | 'safe_fixed' | 'safe_fixed_monotonic_time' | 'size' | 'type' | 'version', Value :: term(). info(Tab, owner) -> @@ -1964,7 +1964,9 @@ do_safe_fixtable(Head, Pid, true) -> case Head#head.fixed of false -> link(Pid), - Fixed = {utime_now(), [{Pid, 1}]}, + MonTime = erlang:monotonic_time(), + TimeOffset = erlang:time_offset(), + Fixed = {{MonTime, TimeOffset}, [{Pid, 1}]}, Ftab = dets_utils:get_freelists(Head), Head#head{fixed = Fixed, freelists = {Ftab, Ftab}}; {TimeStamp, Counters} -> @@ -2091,7 +2093,22 @@ finfo(H, no_keys) -> finfo(H, no_slots) -> {H, (H#head.mod):no_slots(H)}; finfo(H, pid) -> {H, self()}; finfo(H, ram_file) -> {H, H#head.ram_file}; -finfo(H, safe_fixed) -> {H, H#head.fixed}; +finfo(H, safe_fixed) -> + {H, + case H#head.fixed of + false -> + false; + {{FixMonTime, TimeOffset}, RefList} -> + {make_timestamp(FixMonTime, TimeOffset), RefList} + end}; +finfo(H, safe_fixed_monotonic_time) -> + {H, + case H#head.fixed of + false -> + false; + {{FixMonTime, _TimeOffset}, RefList} -> + {FixMonTime, RefList} + end}; finfo(H, size) -> case catch write_cache(H) of {H2, []} -> @@ -3275,11 +3292,14 @@ err(Error) -> time_now() -> erlang:monotonic_time(1000000). --compile({inline, [utime_now/0]}). -utime_now() -> - Time = time_now(), - UniqueCounter = erlang:unique_integer([monotonic]), - {Time, UniqueCounter}. +make_timestamp(MonTime, TimeOffset) -> + ErlangSystemTime = erlang:convert_time_unit(MonTime+TimeOffset, + native, + micro_seconds), + MegaSecs = ErlangSystemTime div 1000000000000, + Secs = ErlangSystemTime div 1000000 - MegaSecs*1000000, + MicroSecs = ErlangSystemTime rem 1000000, + {MegaSecs, Secs, MicroSecs}. %%%%%%%%%%%%%%%%% DEBUG functions %%%%%%%%%%%%%%%% diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl index 196158cd48..34a8ddddaa 100644 --- a/lib/stdlib/src/dets_utils.erl +++ b/lib/stdlib/src/dets_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -747,6 +747,8 @@ all_allocated([{X,Y} | L], _X0, Y0, A) when Y0 < X -> all_allocated_as_list(Head) -> all_allocated_as_list(all(get_freelists(Head)), 0, Head#head.base, []). +-dialyzer({no_improper_lists, all_allocated_as_list/4}). + all_allocated_as_list([], _X0, _Y0, []) -> []; all_allocated_as_list([], _X0, _Y0, A) -> diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl index 49126193b8..1bf53d91b1 100644 --- a/lib/stdlib/src/dets_v8.erl +++ b/lib/stdlib/src/dets_v8.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -36,6 +36,8 @@ %% For backward compatibility. -export([sz2pos/1]). +-dialyzer(no_improper_lists). + -compile({inline, [{sz2pos,1},{scan_skip,7}]}). -compile({inline, [{skip_bytes,5}, {get_segp,1}]}). -compile({inline, [{wl_lookup,5}]}). diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl index 361780c776..6c406fc03a 100644 --- a/lib/stdlib/src/dets_v9.erl +++ b/lib/stdlib/src/dets_v9.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -34,6 +34,8 @@ -export([cache_segps/3]). +-dialyzer(no_improper_lists). + -compile({inline, [{max_objsize,1},{maxobjsize,1}]}). -compile({inline, [{write_segment_file,6}]}). -compile({inline, [{sz2pos,1},{adjsz,1}]}). diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl index 6ce3710f87..f921e28ef6 100644 --- a/lib/stdlib/src/dict.erl +++ b/lib/stdlib/src/dict.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2014. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -333,6 +333,8 @@ update_counter(Key, Incr, D0) when is_number(Incr) -> D0, Slot), maybe_expand(D1, Ic). +-dialyzer({no_improper_lists, counter_bkt/3}). + counter_bkt(Key, I, [?kv(Key,Val)|Bkt]) -> {[?kv(Key,Val+I)|Bkt],0}; counter_bkt(Key, I, [Other|Bkt0]) -> diff --git a/lib/stdlib/src/digraph.erl b/lib/stdlib/src/digraph.erl index e51e560542..8a4df95027 100644 --- a/lib/stdlib/src/digraph.erl +++ b/lib/stdlib/src/digraph.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2014. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -338,6 +338,8 @@ edge(G, E) -> %% -spec new_edge_id(graph()) -> edge(). +-dialyzer({no_improper_lists, new_edge_id/1}). + new_edge_id(G) -> NT = G#digraph.ntab, [{'$eid', K}] = ets:lookup(NT, '$eid'), @@ -350,6 +352,8 @@ new_edge_id(G) -> %% -spec new_vertex_id(graph()) -> vertex(). +-dialyzer({no_improper_lists, new_vertex_id/1}). + new_vertex_id(G) -> NT = G#digraph.ntab, [{'$vid', K}] = ets:lookup(NT, '$vid'), diff --git a/lib/stdlib/src/edlin.erl b/lib/stdlib/src/edlin.erl index 19444c0502..0e9c457de2 100644 --- a/lib/stdlib/src/edlin.erl +++ b/lib/stdlib/src/edlin.erl @@ -465,7 +465,6 @@ word_char(C) when C >= $a, C =< $z -> true; word_char(C) when C >= $ß, C =< $ÿ, C =/= $÷ -> true; word_char(C) when C >= $0, C =< $9 -> true; word_char(C) when C =:= $_ -> true; -word_char(C) when C =:= $. -> true; % accept dot-separated names word_char(_) -> false. %% over_white(Chars, InitialStack, InitialCount) -> diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index ca3cc43b19..40a34aa30f 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -415,7 +415,7 @@ expr({call,_,{atom,_,Func},As0}, Bs0, Lf, Ef, RBs) -> {As,Bs} = expr_list(As0, Bs0, Lf, Ef), bif(Func, As, Bs, Ef, RBs); false -> - local_func(Func, As0, Bs0, Lf, RBs) + local_func(Func, As0, Bs0, Lf, Ef, RBs) end; expr({call,_,Func0,As0}, Bs0, Lf, Ef, RBs) -> % function or {Mod,Fun} {value,Func,Bs1} = expr(Func0, Bs0, Lf, Ef, none), @@ -542,33 +542,34 @@ unhide_calls([E | Es], MaxLine, D) -> unhide_calls(E, _MaxLine, _D) -> E. -%% local_func(Function, Arguments, Bindings, LocalFuncHandler, RBs) -> +%% local_func(Function, Arguments, Bindings, LocalFuncHandler, +%% ExternalFuncHandler, RBs) -> %% {value,Value,Bindings} | Value when %% LocalFuncHandler = {value,F} | {value,F,Eas} | %% {eval,F} | {eval,F,Eas} | none. -local_func(Func, As0, Bs0, {value,F}, value) -> - {As1,_Bs1} = expr_list(As0, Bs0, {value,F}), +local_func(Func, As0, Bs0, {value,F}, Ef, value) -> + {As1,_Bs1} = expr_list(As0, Bs0, {value,F}, Ef), %% Make tail recursive calls when possible. F(Func, As1); -local_func(Func, As0, Bs0, {value,F}, RBs) -> - {As1,Bs1} = expr_list(As0, Bs0, {value,F}), +local_func(Func, As0, Bs0, {value,F}, Ef, RBs) -> + {As1,Bs1} = expr_list(As0, Bs0, {value,F}, Ef), ret_expr(F(Func, As1), Bs1, RBs); -local_func(Func, As0, Bs0, {value,F,Eas}, RBs) -> +local_func(Func, As0, Bs0, {value,F,Eas}, Ef, RBs) -> Fun = fun(Name, Args) -> apply(F, [Name,Args|Eas]) end, - local_func(Func, As0, Bs0, {value, Fun}, RBs); -local_func(Func, As, Bs, {eval,F}, RBs) -> + local_func(Func, As0, Bs0, {value, Fun}, Ef, RBs); +local_func(Func, As, Bs, {eval,F}, _Ef, RBs) -> local_func2(F(Func, As, Bs), RBs); -local_func(Func, As, Bs, {eval,F,Eas}, RBs) -> +local_func(Func, As, Bs, {eval,F,Eas}, _Ef, RBs) -> local_func2(apply(F, [Func,As,Bs|Eas]), RBs); %% These two clauses are for backwards compatibility. -local_func(Func, As0, Bs0, {M,F}, RBs) -> - {As1,Bs1} = expr_list(As0, Bs0, {M,F}), +local_func(Func, As0, Bs0, {M,F}, Ef, RBs) -> + {As1,Bs1} = expr_list(As0, Bs0, {M,F}, Ef), ret_expr(M:F(Func,As1), Bs1, RBs); -local_func(Func, As, _Bs, {M,F,Eas}, RBs) -> +local_func(Func, As, _Bs, {M,F,Eas}, _Ef, RBs) -> local_func2(apply(M, F, [Func,As|Eas]), RBs); %% Default unknown function handler to undefined function. -local_func(Func, As0, _Bs0, none, _RBs) -> +local_func(Func, As0, _Bs0, none, _Ef, _RBs) -> erlang:raise(error, undef, [{erl_eval,Func,length(As0)}|stacktrace()]). local_func2({value,V,Bs}, RBs) -> @@ -1184,7 +1185,7 @@ match_tuple([], _, _, Bs, _BBs) -> match_map([{map_field_exact, _, K, V}|Fs], Map, Bs0, BBs) -> Vm = try - {value, Ke, _} = expr(K, Bs0), + {value, Ke, _} = expr(K, BBs), maps:get(Ke,Map) catch error:_ -> throw(nomatch) diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 5678e7eebe..62b3169a6c 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -100,7 +100,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> %% 'called' and 'exports' contain {Line, {Function, Arity}}, %% the other function collections contain {Function, Arity}. -record(lint, {state=start :: 'start' | 'attribute' | 'function', - module=[], %Module + module='', %Module behaviour=[], %Behaviour exports=gb_sets:empty() :: gb_sets:set(fa()),%Exports imports=[] :: [fa()], %Imports, an orddict() @@ -729,7 +729,7 @@ start_state(Form, St) -> %% attribute_state(Form, State) -> %% State' -attribute_state({attribute,_L,module,_M}, #lint{module=[]}=St) -> +attribute_state({attribute,_L,module,_M}, #lint{module=''}=St) -> St; attribute_state({attribute,L,module,_M}, St) -> add_error(L, redefine_module, St); @@ -3532,6 +3532,8 @@ check_qlc_hrl(Line, M, F, As, St) -> %% deprecated_function(Line, ModName, FuncName, [Arg], State) -> State. %% Add warning for calls to deprecated functions. +-dialyzer({no_match, deprecated_function/5}). + deprecated_function(Line, M, F, As, St) -> Arity = length(As), MFA = {M, F, Arity}, @@ -3560,6 +3562,8 @@ deprecated_function(Line, M, F, As, St) -> St end. +-dialyzer({no_match, deprecated_type/5}). + deprecated_type(L, M, N, As, St) -> NAs = length(As), case otp_internal:obsolete_type(M, N, NAs) of diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 847def2fd8..1fca3624dc 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -146,7 +146,7 @@ info(_) -> Tab :: tab(), Item :: compressed | fixed | heir | keypos | memory | name | named_table | node | owner | protection - | safe_fixed | size | stats | type + | safe_fixed | safe_fixed_monotonic_time | size | stats | type | write_concurrency | read_concurrency, Value :: term(). diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl index 47adb133b0..0d50392b96 100644 --- a/lib/stdlib/src/file_sorter.erl +++ b/lib/stdlib/src/file_sorter.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -28,6 +28,8 @@ check/1, check/2, keycheck/2, keycheck/3]). +-dialyzer(no_improper_lists). + -include_lib("kernel/include/file.hrl"). -define(CHUNKSIZE, 16384). diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl index 62b6ca8a21..2b4472cdf7 100644 --- a/lib/stdlib/src/lists.erl +++ b/lib/stdlib/src/lists.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2013. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -2267,6 +2267,8 @@ ukeysplit_2(I, Y, EY, [Z | L], R) -> ukeysplit_2(_I, Y, _EY, [], R) -> [Y | R]. +-dialyzer({no_improper_lists, ukeymergel/3}). + ukeymergel(I, [T1, [H2 | T2], [H3 | T3] | L], Acc) -> %% The fourth argument, [H2 | H3] (=HdM), may confuse type %% checkers. Its purpose is to ensure that the tests H2 == HdM diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 2d77888512..9d394e19d7 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -23,6 +23,8 @@ %%---------------------------------------------------------------------- +-dialyzer({no_match, obsolete/3}). + -type tag() :: 'deprecated' | 'removed'. %% | 'experimental'. -type mfas() :: mfa() | {atom(), atom(), [byte()]}. -type release() :: string(). @@ -648,6 +650,9 @@ obsolete_1(httpd_conf, is_file, 1) -> obsolete_1(httpd_conf, make_integer, 1) -> {deprecated, "deprecated; use erlang:list_to_integer/1 instead"}; +obsolete_1(overload, _, _) -> + {deprecated, "deprecated; will be removed in OTP 19"}; + obsolete_1(_, _, _) -> no. @@ -695,17 +700,19 @@ is_snmp_agent_function(del_agent_caps, 1) -> true; is_snmp_agent_function(get_agent_caps, 0) -> true; is_snmp_agent_function(_, _) -> false. +-dialyzer({no_match, obsolete_type/3}). + -spec obsolete_type(module(), atom(), arity()) -> 'no' | {tag(), string()} | {tag(), mfas(), release()}. obsolete_type(Module, Name, NumberOfVariables) -> case obsolete_type_1(Module, Name, NumberOfVariables) of -%% {deprecated=Tag,{_,_,_}=Replacement} -> -%% {Tag,Replacement,"in a future release"}; + {deprecated=Tag,{_,_,_}=Replacement} -> + {Tag,Replacement,"in a future release"}; {_,String}=Ret when is_list(String) -> Ret; -%% {_,_,_}=Ret -> -%% Ret; + {_,_,_}=Ret -> + Ret; no -> no end. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 3ba3a88038..1ae7c6cc25 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2015. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -51,6 +51,8 @@ -export([template_state/0, aux_name/3, name_suffix/2, vars/1, var_ufold/2, var_fold/3, all_selections/1]). +-dialyzer(no_improper_lists). + %% When cache=list lists bigger than ?MAX_LIST_SIZE bytes are put on %% file. Also used when merge join finds big equivalence classes. -define(MAX_LIST_SIZE, 512*1024). diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl index dc060e82d9..d455abf7b0 100644 --- a/lib/stdlib/src/rand.erl +++ b/lib/stdlib/src/rand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2015. All Rights Reserved. +%% Copyright Ericsson AB 2015-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -256,6 +256,8 @@ exs64_uniform(Max, {Alg, R}) -> %% ===================================================================== -type exsplus_state() :: nonempty_improper_list(uint58(), uint58()). +-dialyzer({no_improper_lists, exsplus_seed/1}). + exsplus_seed({A1, A2, A3}) -> {_, R1} = exsplus_next([(((A1 * 4294967197) + 1) band ?UINT58MASK)| (((A2 * 4294967231) + 1) band ?UINT58MASK)]), @@ -263,6 +265,8 @@ exsplus_seed({A1, A2, A3}) -> tl(R1)]), R2. +-dialyzer({no_improper_lists, exsplus_next/1}). + %% Advance xorshift116+ state for one step and generate 58bit unsigned integer -spec exsplus_next(exsplus_state()) -> {uint58(), exsplus_state()}. exsplus_next([S1|S0]) -> diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src index 7f9bbbf649..b8a7973cf2 100644 --- a/lib/stdlib/src/stdlib.app.src +++ b/lib/stdlib/src/stdlib.app.src @@ -105,7 +105,7 @@ dets]}, {applications, [kernel]}, {env, []}, - {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.0","crypto-3.3", + {runtime_dependencies, ["sasl-2.6","kernel-4.1","erts-7.3","crypto-3.3", "compiler-5.0"]} ]}. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 92a0c29011..cecdebd0c8 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -33,6 +33,9 @@ terminate/2, code_change/3]). -export([try_again_restart/2]). +%% For release_handler only +-export([get_callback_module/1]). + %%-------------------------------------------------------------------------- -export_type([sup_flags/0, child_spec/0, startchild_ret/0, strategy/0]). @@ -113,6 +116,7 @@ intensity :: non_neg_integer(), period :: pos_integer(), restarts = [], + dynamic_restarts = 0 :: non_neg_integer(), module, args}). -type state() :: #state{}. @@ -250,6 +254,17 @@ try_again_restart(Supervisor, Child) -> cast(Supervisor, Req) -> gen_server:cast(Supervisor, Req). +%%%----------------------------------------------------------------- +%%% Called by release_handler during upgrade +-spec get_callback_module(Pid) -> Module when + Pid :: pid(), + Module :: atom(). +get_callback_module(Pid) -> + {status, _Pid, {module, _Mod}, + [_PDict, _SysState, _Parent, _Dbg, Misc]} = sys:get_status(Pid), + [_Header, _Data, {data, [{"State", State}]}] = Misc, + State#state.module. + %%% --------------------------------------------------- %%% %%% Initialize the supervisor. @@ -504,39 +519,26 @@ handle_call(which_children, _From, State) -> handle_call(count_children, _From, #state{children = [#child{restart_type = temporary, child_type = CT}]} = State) when ?is_simple(State) -> - {Active, Count} = - ?SETS:fold(fun(Pid, {Alive, Tot}) -> - case is_pid(Pid) andalso is_process_alive(Pid) of - true ->{Alive+1, Tot +1}; - false -> - {Alive, Tot + 1} - end - end, {0, 0}, dynamics_db(temporary, State#state.dynamics)), + Sz = ?SETS:size(dynamics_db(temporary, State#state.dynamics)), Reply = case CT of - supervisor -> [{specs, 1}, {active, Active}, - {supervisors, Count}, {workers, 0}]; - worker -> [{specs, 1}, {active, Active}, - {supervisors, 0}, {workers, Count}] + supervisor -> [{specs, 1}, {active, Sz}, + {supervisors, Sz}, {workers, 0}]; + worker -> [{specs, 1}, {active, Sz}, + {supervisors, 0}, {workers, Sz}] end, {reply, Reply, State}; -handle_call(count_children, _From, #state{children = [#child{restart_type = RType, +handle_call(count_children, _From, #state{dynamic_restarts = Restarts, + children = [#child{restart_type = RType, child_type = CT}]} = State) when ?is_simple(State) -> - {Active, Count} = - ?DICTS:fold(fun(Pid, _Val, {Alive, Tot}) -> - case is_pid(Pid) andalso is_process_alive(Pid) of - true -> - {Alive+1, Tot +1}; - false -> - {Alive, Tot + 1} - end - end, {0, 0}, dynamics_db(RType, State#state.dynamics)), + Sz = ?DICTS:size(dynamics_db(RType, State#state.dynamics)), + Active = Sz - Restarts, Reply = case CT of supervisor -> [{specs, 1}, {active, Active}, - {supervisors, Count}, {workers, 0}]; + {supervisors, Sz}, {workers, 0}]; worker -> [{specs, 1}, {active, Active}, - {supervisors, 0}, {workers, Count}] + {supervisors, 0}, {workers, Sz}] end, {reply, Reply, State}; @@ -806,8 +808,15 @@ restart(Child, State) -> {shutdown, remove_child(Child, NState)} end. -restart(simple_one_for_one, Child, State) -> +restart(simple_one_for_one, Child, State0) -> #child{pid = OldPid, mfargs = {M, F, A}} = Child, + State = case OldPid of + ?restarting(_) -> + NRes = State0#state.dynamic_restarts - 1, + State0#state{dynamic_restarts = NRes}; + _ -> + State0 + end, Dynamics = ?DICTS:erase(OldPid, dynamics_db(Child#child.restart_type, State#state.dynamics)), case do_start_child_i(M, F, A) of @@ -818,7 +827,9 @@ restart(simple_one_for_one, Child, State) -> NState = State#state{dynamics = ?DICTS:store(Pid, A, Dynamics)}, {ok, NState}; {error, Error} -> - NState = State#state{dynamics = ?DICTS:store(restarting(OldPid), A, + NRestarts = State#state.dynamic_restarts + 1, + NState = State#state{dynamic_restarts = NRestarts, + dynamics = ?DICTS:store(restarting(OldPid), A, Dynamics)}, report_error(start_error, Error, Child, State#state.name), {try_again, NState} diff --git a/lib/stdlib/src/unicode.erl b/lib/stdlib/src/unicode.erl index 3e8e6f5101..617da11ba8 100644 --- a/lib/stdlib/src/unicode.erl +++ b/lib/stdlib/src/unicode.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2013. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -561,6 +561,8 @@ do_o_binary(F,L) -> erlang:iolist_to_binary(List) end. +-dialyzer({no_improper_lists, do_o_binary2/2}). + do_o_binary2(_F,[]) -> <<>>; do_o_binary2(F,[H|T]) -> diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index bec0bd3f6d..f8ba6f18e9 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2013. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -1566,6 +1566,8 @@ append_bins([_|_]=List, B) -> append_bins([], B) -> B. +-dialyzer({no_improper_lists, pwrite_iolist/3}). + pwrite_iolist(B, Pos, Bin) -> {Left, Right} = split_binary(B, Pos), Sz = erlang:iolist_size(Bin), diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index 7f5e06524a..35e587afcc 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -1876,9 +1876,33 @@ fixtable(Config, Version) when is_list(Config) -> {ok, _} = dets:open_file(T, [{type, duplicate_bag} | Args]), %% In a fixed table, delete and re-insert an object. ok = dets:insert(T, {1, a, b}), + SysBefore = erlang:timestamp(), + MonBefore = erlang:monotonic_time(), dets:safe_fixtable(T, true), + MonAfter = erlang:monotonic_time(), + SysAfter = erlang:timestamp(), + Self = self(), + {FixMonTime,[{Self,1}]} = dets:info(T,safe_fixed_monotonic_time), + {FixSysTime,[{Self,1}]} = dets:info(T,safe_fixed), + true = is_integer(FixMonTime), + true = MonBefore =< FixMonTime, + true = FixMonTime =< MonAfter, + {FstMs,FstS,FstUs} = FixSysTime, + true = is_integer(FstMs), + true = is_integer(FstS), + true = is_integer(FstUs), + case erlang:system_info(time_warp_mode) of + no_time_warp -> + true = timer:now_diff(FixSysTime, SysBefore) >= 0, + true = timer:now_diff(SysAfter, FixSysTime) >= 0; + _ -> + %% ets:info(Tab,safe_fixed) not timewarp safe... + ignore + end, ok = dets:match_delete(T, {1, a, b}), ok = dets:insert(T, {1, a, b}), + {FixMonTime,[{Self,1}]} = dets:info(T,safe_fixed_monotonic_time), + {FixSysTime,[{Self,1}]} = dets:info(T,safe_fixed), dets:safe_fixtable(T, false), 1 = length(dets:match_object(T, '_')), diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index b9c4ad0a46..c21c4e61ee 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1998-2013. All Rights Reserved. +%% Copyright Ericsson AB 1998-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -39,6 +39,7 @@ otp_7550/1, otp_8133/1, otp_10622/1, + otp_13228/1, funs/1, try_catch/1, eval_expr_5/1, @@ -83,7 +84,8 @@ all() -> pattern_expr, match_bin, guard_3, guard_4, guard_5, lc, simple_cases, unary_plus, apply_atom, otp_5269, otp_6539, otp_6543, otp_6787, otp_6977, otp_7550, - otp_8133, otp_10622, funs, try_catch, eval_expr_5, zero_width, + otp_8133, otp_10622, otp_13228, + funs, try_catch, eval_expr_5, zero_width, eep37, eep43]. groups() -> @@ -1042,6 +1044,13 @@ otp_10622(Config) when is_list(Config) -> ok. +otp_13228(doc) -> + ["OTP-13228. ERL-32: non-local function handler bug."]; +otp_13228(_Config) -> + LFH = {value, fun(foo, [io_fwrite]) -> worked end}, + EFH = {value, fun({io, fwrite}, [atom]) -> io_fwrite end}, + {value, worked, []} = parse_and_run("foo(io:fwrite(atom)).", LFH, EFH). + funs(doc) -> ["Simple cases, just to cover some code."]; funs(suite) -> @@ -1483,6 +1492,16 @@ eep43(Config) when is_list(Config) -> " #{ K1 := 1, K2 := 2, K3 := 3, {2,2} := 4} = Map " "end.", #{ 1 => 1, <<42:301>> => 2, {3,<<42:301>>} => 3, {2,2} => 4}), + check(fun () -> + X = key, + (fun(#{X := value}) -> true end)(#{X => value}) + end, + "begin " + " X = key, " + " (fun(#{X := value}) -> true end)(#{X => value}) " + "end.", + true), + error_check("[camembert]#{}.", {badmap,[camembert]}), error_check("[camembert]#{nonexisting:=v}.", {badmap,[camembert]}), error_check("#{} = 1.", {badmatch,1}), diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 5347ccaf1f..375fb6bc93 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2015. All Rights Reserved. +%% Copyright Ericsson AB 1999-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -65,7 +65,7 @@ too_many_arguments/1, basic_errors/1,bin_syntax_errors/1, predef/1, - maps/1,maps_type/1,otp_11851/1,otp_12195/1 + maps/1,maps_type/1,otp_11851/1,otp_12195/1, otp_13230/1 ]). % Default timetrap timeout (set in init_per_testcase). @@ -94,7 +94,7 @@ all() -> bif_clash, behaviour_basic, behaviour_multiple, otp_11861, otp_7550, otp_8051, format_warn, {group, on_load}, too_many_arguments, basic_errors, bin_syntax_errors, predef, - maps, maps_type, otp_11851, otp_12195]. + maps, maps_type, otp_11851, otp_12195, otp_13230]. groups() -> [{unused_vars_warn, [], @@ -3877,6 +3877,15 @@ otp_12195(Config) when is_list(Config) -> [] = run(Config, Ts), ok. +otp_13230(doc) -> + "OTP-13230: -deprecated without -module"; +otp_13230(Config) when is_list(Config) -> + Abstr = <<"-deprecated([{frutt,0,next_version}]).">>, + {errors,[{1,erl_lint,undefined_module}, + {1,erl_lint,{bad_deprecated,{frutt,0}}}], + []} = run_test2(Config, Abstr, []), + ok. + run(Config, Tests) -> F = fun({N,P,Ws,E}, BadL) -> case catch run_test(Config, P, Ws) of diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index ae431d66d9..30a158d9e1 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -3989,15 +3989,37 @@ safe_fixtable_do(Opts) -> ?line true = ets:safe_fixtable(Tab, true), ?line receive after 1 -> ok end, ?line true = ets:safe_fixtable(Tab, false), - ?line false = ets:info(Tab,safe_fixed), - ?line true = ets:safe_fixtable(Tab, true), + false = ets:info(Tab,safe_fixed_monotonic_time), + false = ets:info(Tab,safe_fixed), + SysBefore = erlang:timestamp(), + MonBefore = erlang:monotonic_time(), + true = ets:safe_fixtable(Tab, true), + MonAfter = erlang:monotonic_time(), + SysAfter = erlang:timestamp(), Self = self(), - ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed), + {FixMonTime,[{Self,1}]} = ets:info(Tab,safe_fixed_monotonic_time), + {FixSysTime,[{Self,1}]} = ets:info(Tab,safe_fixed), + true = is_integer(FixMonTime), + true = MonBefore =< FixMonTime, + true = FixMonTime =< MonAfter, + {FstMs,FstS,FstUs} = FixSysTime, + true = is_integer(FstMs), + true = is_integer(FstS), + true = is_integer(FstUs), + case erlang:system_info(time_warp_mode) of + no_time_warp -> + true = timer:now_diff(FixSysTime, SysBefore) >= 0, + true = timer:now_diff(SysAfter, FixSysTime) >= 0; + _ -> + %% ets:info(Tab,safe_fixed) not timewarp safe... + ignore + end, %% Test that an unjustified 'unfix' is a no-op. {Pid,MRef} = my_spawn_monitor(fun() -> true = ets:safe_fixtable(Tab,false) end), {'DOWN', MRef, process, Pid, normal} = receive M -> M end, - ?line true = ets:info(Tab,fixed), - ?line {{_,_,_},[{Self,1}]} = ets:info(Tab,safe_fixed), + true = ets:info(Tab,fixed), + {FixMonTime,[{Self,1}]} = ets:info(Tab,safe_fixed_monotonic_time), + {FixSysTime,[{Self,1}]} = ets:info(Tab,safe_fixed), %% badarg's ?line {'EXIT', {badarg, _}} = (catch ets:safe_fixtable(Tab, foobar)), ?line true = ets:info(Tab,fixed), @@ -4043,6 +4065,7 @@ info_do(Opts) -> ?line undefined = ets:info(non_existing_table_xxyy,type), ?line undefined = ets:info(non_existing_table_xxyy,node), ?line undefined = ets:info(non_existing_table_xxyy,named_table), + ?line undefined = ets:info(non_existing_table_xxyy,safe_fixed_monotonic_time), ?line undefined = ets:info(non_existing_table_xxyy,safe_fixed), ?line verify_etsmem(EtsMem). @@ -5532,7 +5555,7 @@ otp_8166_zombie_creator(T,Deleted) -> [{'=<','$1', Deleted}], [true]}]), Pid ! zombies_created, - repeat_while(fun() -> case ets:info(T,safe_fixed) of + repeat_while(fun() -> case ets:info(T,safe_fixed_monotonic_time) of {_,[_P1,_P2]} -> false; _ -> diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index 8cb2a5194a..903ca76575 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -67,6 +67,7 @@ %% Misc tests -export([child_unlink/1, tree/1, count_children/1, + count_restarting_children/1, do_not_save_start_parameters_for_temporary_children/1, do_not_save_child_specs_for_temporary_children/1, simple_one_for_one_scale_many_temporary_children/1, @@ -90,7 +91,8 @@ all() -> {group, normal_termination}, {group, shutdown_termination}, {group, abnormal_termination}, child_unlink, tree, - count_children, do_not_save_start_parameters_for_temporary_children, + count_children, count_restarting_children, + do_not_save_start_parameters_for_temporary_children, do_not_save_child_specs_for_temporary_children, simple_one_for_one_scale_many_temporary_children, temporary_bystander, simple_global_supervisor, hanging_restart_loop, hanging_restart_loop_simple, @@ -1459,6 +1461,54 @@ count_children(Config) when is_list(Config) -> [1,0,0,0] = get_child_counts(sup_test). %%------------------------------------------------------------------------- +%% Test count_children when some children are restarting +count_restarting_children(Config) when is_list(Config) -> + process_flag(trap_exit, true), + Child = {child, {supervisor_deadlock, start_child_noreg, []}, + permanent, brutal_kill, worker, []}, + %% 2 sek delay on failing restart (see supervisor_deadlock.erl) -> + %% MaxR=20, MaxT=10 should ensure a restart loop when starting and + %% restarting 3 instances of the child (as below) + {ok, SupPid} = start_link({ok, {{simple_one_for_one, 20, 10}, [Child]}}), + + %% Ets table with state read by supervisor_deadlock.erl + ets:new(supervisor_deadlock,[set,named_table,public]), + ets:insert(supervisor_deadlock,{fail_start,false}), + + [1,0,0,0] = get_child_counts(SupPid), + {ok, Ch1_1} = supervisor:start_child(SupPid, []), + [1,1,0,1] = get_child_counts(SupPid), + {ok, Ch1_2} = supervisor:start_child(SupPid, []), + [1,2,0,2] = get_child_counts(SupPid), + {ok, Ch1_3} = supervisor:start_child(SupPid, []), + [1,3,0,3] = get_child_counts(SupPid), + + supervisor_deadlock:restart_child(Ch1_1), + supervisor_deadlock:restart_child(Ch1_2), + supervisor_deadlock:restart_child(Ch1_3), + test_server:sleep(400), + [1,3,0,3] = get_child_counts(SupPid), + [Ch2_1, Ch2_2, Ch2_3] = [C || {_,C,_,_} <- supervisor:which_children(SupPid)], + + ets:insert(supervisor_deadlock,{fail_start,true}), + supervisor_deadlock:restart_child(Ch2_1), + supervisor_deadlock:restart_child(Ch2_2), + test_server:sleep(4000), % allow restart to happen before proceeding + [1,1,0,3] = get_child_counts(SupPid), + + ets:insert(supervisor_deadlock,{fail_start,false}), + test_server:sleep(4000), % allow restart to happen before proceeding + [1,3,0,3] = get_child_counts(SupPid), + + ok = supervisor:terminate_child(SupPid, Ch2_3), + [1,2,0,2] = get_child_counts(SupPid), + [Ch3_1, Ch3_2] = [C || {_,C,_,_} <- supervisor:which_children(SupPid)], + ok = supervisor:terminate_child(SupPid, Ch3_1), + [1,1,0,1] = get_child_counts(SupPid), + ok = supervisor:terminate_child(SupPid, Ch3_2), + [1,0,0,0] = get_child_counts(SupPid). + +%%------------------------------------------------------------------------- %% Temporary children shall not be restarted so they should not save %% start parameters, as it potentially can take up a huge amount of %% memory for no purpose. diff --git a/lib/stdlib/test/supervisor_deadlock.erl b/lib/stdlib/test/supervisor_deadlock.erl index 288547a972..8d3d1c6f30 100644 --- a/lib/stdlib/test/supervisor_deadlock.erl +++ b/lib/stdlib/test/supervisor_deadlock.erl @@ -11,9 +11,11 @@ init([child]) -> %% terminates immediately {ok, []}; [{fail_start, true}] -> - %% Restart frequency is MaxR=8, MaxT=10, so this will - %% ensure that restart intensity is not reached -> restart - %% loop + %% A restart frequency of MaxR=8, MaxT=10 should ensure + %% that restart intensity is not reached -> restart loop. + %% (Note that if we use simple_one_for_one, and start + %% 'many' child instances, the restart frequency must be + %% ajusted accordingly.) timer:sleep(2000), % NOTE: this could be a gen_server call timeout {stop, error} @@ -41,5 +43,11 @@ code_change(_OldVsn, State, _Extra) -> start_child() -> gen_server:start_link({local, ?MODULE}, ?MODULE, [child], []). +start_child_noreg() -> + gen_server:start_link(?MODULE, [child], []). + restart_child() -> gen_server:cast(supervisor_deadlock, restart). + +restart_child(Pid) -> + gen_server:cast(Pid, restart). diff --git a/lib/test_server/src/test_server_node.erl b/lib/test_server/src/test_server_node.erl index 4e6839fc6b..e870a55398 100644 --- a/lib/test_server/src/test_server_node.erl +++ b/lib/test_server/src/test_server_node.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2014. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -121,7 +121,7 @@ start_tracer_node(TraceFile,TI) -> %%% trace_nodes(Sock,Nodes) -> Bin = term_to_binary({add_nodes,Nodes}), - ok = gen_tcp:send(Sock, [1|Bin]), + ok = gen_tcp:send(Sock, tag_trace_message(Bin)), receive_ack(Sock). @@ -142,7 +142,7 @@ receive_ack(Sock) -> %%% stop_tracer_node(Sock) -> Bin = term_to_binary(id(stop)), - ok = gen_tcp:send(Sock, [1|Bin]), + ok = gen_tcp:send(Sock, tag_trace_message(Bin)), receive {tcp_closed,Sock} -> gen_tcp:close(Sock) end, ok. @@ -171,7 +171,7 @@ trc([TraceFile, PortAtom, Type]) -> {packet,2}]) of {ok,Sock} -> BinResult = term_to_binary(Result), - ok = gen_tcp:send(Sock,[1|BinResult]), + ok = gen_tcp:send(Sock,tag_trace_message(BinResult)), trc_loop(Sock,Patterns,Type); _else -> ok @@ -187,7 +187,7 @@ trc_loop(Sock,Patterns,Type) -> {ok,{add_nodes,Nodes}} -> add_nodes(Nodes,Patterns,Type), Bin = term_to_binary(id(ok)), - ok = gen_tcp:send(Sock, [1|Bin]), + ok = gen_tcp:send(Sock, tag_trace_message(Bin)), trc_loop(Sock,Patterns,Type); {ok,stop} -> ttb:stop(), @@ -482,7 +482,7 @@ node_started(Host,PortAtom) -> {ok,Sock} -> Started = term_to_binary({started, node(), Version, VsnStr}), - ok = gen_tcp:send(Sock, [1|Started]), + ok = gen_tcp:send(Sock, tag_trace_message(Started)), receive _Anyting -> gen_tcp:close(Sock), erlang:halt() @@ -492,8 +492,10 @@ node_started(Host,PortAtom) -> end. - - +-compile({inline, [tag_trace_message/1]}). +-dialyzer({no_improper_lists, tag_trace_message/1}). +tag_trace_message(M) -> + [1|M]. % start_which_node(Optlist) -> hostname start_which_node(Optlist) -> diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 366d6bcbd9..d16ca7f406 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -1474,7 +1474,7 @@ do_compile_beam(Module,BeamFile0,State) -> {ok,Module,BeamFile}; error -> {error, BeamFile}; - {error,Reason} -> % no abstract code + {error,Reason} -> % no abstract code or no 'file' attribute {error, {Reason, BeamFile}} end; {error,no_beam} -> @@ -1537,32 +1537,11 @@ do_compile_beam1(Module,Beam,UserOptions) -> {error,E}; {raw_abstract_v1,Code} -> Forms0 = epp:interpret_file_attribute(Code), - {Forms,Vars} = transform(Forms0, Module), - - %% We need to recover the source from the compilation - %% info otherwise the newly compiled module will have - %% source pointing to the current directory - SourceInfo = get_source_info(Module, Beam), - - %% Compile and load the result - %% It's necessary to check the result of loading since it may - %% fail, for example if Module resides in a sticky directory - {ok, Module, Binary} = compile:forms(Forms, SourceInfo ++ UserOptions), - case code:load_binary(Module, ?TAG, Binary) of - {module, Module} -> - - %% Store info about all function clauses in database - InitInfo = lists:reverse(Vars#vars.init_info), - ets:insert(?COVER_CLAUSE_TABLE, {Module, InitInfo}), - - %% Store binary code so it can be loaded on remote nodes - ets:insert(?BINARY_TABLE, {Module, Binary}), - - {ok, Module}; - - _Error -> - do_clear(Module), - error + case find_main_filename(Forms0) of + {ok,MainFile} -> + do_compile_beam2(Module,Beam,UserOptions,Forms0,MainFile); + Error -> + Error end; {_VSN,_Code} -> %% Wrong version of abstract code. Just report that there @@ -1579,6 +1558,35 @@ get_abstract_code(Module, Beam) -> Error -> Error end. +do_compile_beam2(Module,Beam,UserOptions,Forms0,MainFile) -> + {Forms,Vars} = transform(Forms0, Module, MainFile), + + %% We need to recover the source from the compilation + %% info otherwise the newly compiled module will have + %% source pointing to the current directory + SourceInfo = get_source_info(Module, Beam), + + %% Compile and load the result + %% It's necessary to check the result of loading since it may + %% fail, for example if Module resides in a sticky directory + {ok, Module, Binary} = compile:forms(Forms, SourceInfo ++ UserOptions), + case code:load_binary(Module, ?TAG, Binary) of + {module, Module} -> + + %% Store info about all function clauses in database + InitInfo = lists:reverse(Vars#vars.init_info), + ets:insert(?COVER_CLAUSE_TABLE, {Module, InitInfo}), + + %% Store binary code so it can be loaded on remote nodes + ets:insert(?BINARY_TABLE, {Module, Binary}), + + {ok, Module}; + + _Error -> + do_clear(Module), + error + end. + get_source_info(Module, Beam) -> Compile = get_compile_info(Module, Beam), case lists:keyfind(source, 1, Compile) of @@ -1601,8 +1609,7 @@ get_compile_info(Module, Beam) -> [] end. -transform(Code, Module) -> - MainFile=find_main_filename(Code), +transform(Code, Module, MainFile) -> Vars0 = #vars{module=Module}, {ok,MungedForms,Vars} = transform_2(Code,[],Vars0,MainFile,on), {MungedForms,Vars}. @@ -1610,9 +1617,12 @@ transform(Code, Module) -> %% Helpfunction which returns the first found file-attribute, which can %% be interpreted as the name of the main erlang source file. find_main_filename([{attribute,_,file,{MainFile,_}}|_]) -> - MainFile; + {ok,MainFile}; find_main_filename([_|Rest]) -> - find_main_filename(Rest). + find_main_filename(Rest); +find_main_filename([]) -> + {error, no_file_attribute}. + transform_2([Form0|Forms],MungedForms,Vars,MainFile,Switch) -> Form = expand(Form0), @@ -1995,7 +2005,7 @@ munge_expr({lc,Line,Expr,Qs}, Vars) -> {{lc,Line,MungedExpr,MungedQs}, Vars3}; munge_expr({bc,Line,Expr,Qs}, Vars) -> {bin,BLine,[{bin_element,EL,Val,Sz,TSL}|Es]} = Expr, - Expr2 = {bin,BLine,[{bin_element,EL,?BLOCK1(Val),Sz,TSL}|Es]}, + Expr2 = {bin,BLine,[{bin_element,EL,Val,Sz,TSL}|Es]}, {MungedExpr,Vars2} = munge_expr(Expr2, Vars), {MungedQs, Vars3} = munge_qualifiers(Qs, Vars2), {{bc,Line,MungedExpr,MungedQs}, Vars3}; diff --git a/lib/tools/src/cprof.erl b/lib/tools/src/cprof.erl index 0240f876bc..f6d68f0bf8 100644 --- a/lib/tools/src/cprof.erl +++ b/lib/tools/src/cprof.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -114,6 +114,7 @@ analyse(Limit) when is_integer(Limit) -> analyse(M) when is_atom(M) -> analyse(M, 1). +-dialyzer({no_improper_lists, analyse/2}). analyse(M, Limit) when is_atom(M), is_integer(Limit) -> L0 = [begin MFA = {M,F,A}, diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl index 7c6fab0b75..c5c24c8eb3 100644 --- a/lib/tools/src/fprof.erl +++ b/lib/tools/src/fprof.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -2251,6 +2251,8 @@ do_analyse(Table, Analyse) -> ?dbg(5, "do_analyse_1(_, _) ->~p~n", [Result]), Result. +-dialyzer({no_improper_lists, do_analyse_1/2}). + do_analyse_1(Table, #analyse{group_leader = GroupLeader, dest = Io, @@ -2624,6 +2626,8 @@ funcstat_pd(Pid, Func1, Func0, Clocks) -> funcstat_sort_r(FuncstatList, Element) -> funcstat_sort_r_1(FuncstatList, Element, []). +-dialyzer({no_improper_lists, funcstat_sort_r_1/3}). + funcstat_sort_r_1([], _, R) -> postsort_r(lists:sort(R)); funcstat_sort_r_1([#funcstat{callers_sum = #clocks{} = Clocks, @@ -2646,6 +2650,8 @@ funcstat_sort_r_1([#funcstat{callers_sum = #clocks{} = Clocks, clocks_sort_r(L, E) -> clocks_sort_r_1(L, E, []). +-dialyzer({no_improper_lists, clocks_sort_r_1/3}). + clocks_sort_r_1([], _, R) -> postsort_r(lists:sort(R)); clocks_sort_r_1([#clocks{} = C | L], E, R) -> diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index e8b3d242e4..3a3cebf3ed 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -933,7 +933,6 @@ 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/lib/tools/src/xref_utils.erl b/lib/tools/src/xref_utils.erl index 438ec93962..f69aa70244 100644 --- a/lib/tools/src/xref_utils.erl +++ b/lib/tools/src/xref_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2014. All Rights Reserved. +%% Copyright Ericsson AB 2000-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -245,6 +245,8 @@ select_last_application_version(AppVs) -> TL = to_external(partition(1, relation(AppVs))), [last(keysort(2, L)) || L <- TL]. +-record(scan, {collected = [], errors = [], seen = [], unreadable = []}). + %% scan_directory(Directory, Recurse, Collect, Watch) -> %% {Collected, Errors, Seen, Unreadable} %% @@ -261,8 +263,9 @@ select_last_application_version(AppVs) -> %% Unreadable. %% scan_directory(File, Recurse, Collect, Watch) -> - Init = [[] | {[],[],[]}], - [L | {E,J,U}] = find_files_dir(File, Recurse, Collect, Watch, Init), + Init = #scan{}, + S = find_files_dir(File, Recurse, Collect, Watch, Init), + #scan{collected = L, errors = E, seen = J, unreadable = U} = S, {reverse(L), reverse(E), reverse(J), reverse(U)}. %% {Dir, Basename} | false @@ -576,8 +579,7 @@ find_files_dir(Dir, Recurse, Collect, Watch, L) -> {ok, Files} -> find_files(sort(Files), Dir, Recurse, Collect, Watch, L); {error, Error} -> - [B | {E,J,U}] = L, - [B | {[file_error(Dir, Error)|E],J,U}] + L#scan{errors = [file_error(Dir, Error)|L#scan.errors]} end. find_files([F | Fs], Dir, Recurse, Collect, Watch, L) -> @@ -588,22 +590,23 @@ find_files([F | Fs], Dir, Recurse, Collect, Watch, L) -> {ok, {_, directory, _, _}} -> L; Info -> - [B | EJU = {E,J,U}] = L, + #scan{collected = B, errors = E, + seen = J, unreadable = U} = L, Ext = filename:extension(File), C = member(Ext, Collect), case C of true -> case Info of {ok, {_, file, readable, _}} -> - [[{Dir,F} | B] | EJU]; + L#scan{collected = [{Dir,F} | B]}; {ok, {_, file, unreadable, _}} -> - [B | {E,J,[File|U]}]; + L#scan{unreadable = [File|U]}; Error -> - [B | {[Error|E],J,U}] + L#scan{errors = [Error|E]} end; false -> case member(Ext, Watch) of - true -> [B | {E,[File|J],U}]; + true -> L#scan{seen = [File|J]}; false -> L end end diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 25c9317608..71570a55fa 100644 --- a/lib/tools/test/cover_SUITE.erl +++ b/lib/tools/test/cover_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2015. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -19,43 +19,17 @@ %% -module(cover_SUITE). --export([all/0, init_per_testcase/2, end_per_testcase/2, - suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). - --export([coverage/1, coverage_analysis/1, - start/1, compile/1, analyse/1, misc/1, stop/1, - distribution/1, reconnect/1, die_and_reconnect/1, - dont_reconnect_after_stop/1, stop_node_after_disconnect/1, - export_import/1, - otp_5031/1, eif/1, otp_5305/1, otp_5418/1, otp_6115/1, otp_7095/1, - otp_8188/1, otp_8270/1, otp_8273/1, otp_8340/1, - otp_10979_hanging_node/1, compile_beam_opts/1, eep37/1, - analyse_no_beam/1, line_0/1]). - --export([do_coverage/1]). - --export([distribution_performance/1]). +-compile(export_all). -include_lib("test_server/include/test_server.hrl"). -%%---------------------------------------------------------------------- -%% The following directory structure is assumed: -%% cwd __________________________________________ -%% | \ \ \ \ \ \ \ -%% a b cc d f d1 compile_beam_____ otp_6115 -%% | \ \ \ \ \ \ \ -%% e crypt v w x d f1 f2 -%% | -%% y -%%---------------------------------------------------------------------- - suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> NoStartStop = [eif,otp_5305,otp_5418,otp_7095,otp_8273, otp_8340,otp_8188,compile_beam_opts,eep37, - analyse_no_beam, line_0], + analyse_no_beam, line_0, compile_beam_no_file, + otp_13277], StartStop = [start, compile, analyse, misc, stop, distribution, reconnect, die_and_reconnect, dont_reconnect_after_stop, stop_node_after_disconnect, @@ -778,8 +752,8 @@ distribution_performance(Config) -> %% [{ok,_} = cover:compile_beam(Mod) || Mod <- Mods] %% end, CFun = fun() -> cover:compile_beam(Mods) end, - {CT,CA} = timer:tc(CFun), -% erlang:display(CA), + {CT,_CA} = timer:tc(CFun), +% erlang:display(_CA), erlang:display({compile,CT}), {SNT,_} = timer:tc(fun() -> {ok,[N1]} = cover:start(nodes()) end), @@ -799,7 +773,7 @@ distribution_performance(Config) -> % Fun = fun() -> cover:reset() end, - {AT,A} = timer:tc(Fun), + {AT,_A} = timer:tc(Fun), erlang:display({analyse,AT}), % erlang:display(lists:sort([X || X={_MFA,N} <- lists:append([L || {ok,L}<-A]), N=/=0])), @@ -1279,7 +1253,7 @@ otp_8340(doc) -> ["OTP-8340. Bug."]; otp_8340(suite) -> []; otp_8340(Config) when is_list(Config) -> - ?line [{{t,1},1},{{t,2},1},{{t,4},1}] = + ?line [{{t,1},1},{{t,4},1}] = analyse_expr(<<"<< \n" " <<3:2, \n" " SeqId:62>> \n" @@ -1573,8 +1547,10 @@ comprehension_8188(Cf) -> " true]. \n" % 2 " two() -> 2">>, Cf), % 1 + %% The template cannot have a counter since it is not allowed to + %% be a block. ?line [{{t,1},1}, - {{t,2},2}, + %% {{t,2},2}, {{t,3},1}, {{t,4},1}, {{t,5},0}, @@ -1584,7 +1560,7 @@ comprehension_8188(Cf) -> {{t,13},2}, {{t,14},2}] = analyse_expr(<<"<< \n" % 1 - " << (X*2) >> || \n" % 2 + " << (X*2) >> || \n" % 2 (now: 0) " <<X>> <= << (case two() of\n" " 2 -> 1;\n" % 1 " _ -> 2\n" % 0 @@ -1599,7 +1575,7 @@ comprehension_8188(Cf) -> "two() -> 2">>, Cf), ?line [{{t,1},1}, - {{t,2},4}, + %% {{t,2},4}, {{t,4},1}, {{t,6},1}, {{t,7},0}, @@ -1608,7 +1584,7 @@ comprehension_8188(Cf) -> {{t,12},4}, {{t,13},1}] = analyse_expr(<<"<< \n" % 1 - " << (2)\n" % 4 + " << (2)\n" % 4 (now: 0) " :(8) >> || \n" " <<X>> <= << 1,\n" % 1 " (case two() of \n" @@ -1746,6 +1722,49 @@ line_0(Config) -> ok. +%% OTP-13200: Return error instead of crashing when trying to compile +%% a beam which has no 'file' attribute. +compile_beam_no_file(Config) -> + PrivDir = ?config(priv_dir,Config), + Dir = filename:join(PrivDir,"compile_beam_no_file"), + ok = filelib:ensure_dir(filename:join(Dir,"*")), + code:add_patha(Dir), + Str = lists:concat( + ["-module(nofile).\n" + "-compile(export_all).\n" + "foo() -> ok.\n"]), + TT = do_scan(Str), + Forms = [ begin {ok,Y} = erl_parse:parse_form(X),Y end || X <- TT ], + {ok,_,Bin} = compile:forms(Forms,[debug_info]), + BeamFile = filename:join(Dir,"nofile.beam"), + ok = file:write_file(BeamFile,Bin), + {error,{no_file_attribute,BeamFile}} = cover:compile_beam(nofile), + [{error,{no_file_attribute,BeamFile}}] = cover:compile_beam_directory(Dir), + ok. + +do_scan([]) -> + []; +do_scan(Str) -> + {done,{ok,T,_},C} = erl_scan:tokens([],Str,0), + [ T | do_scan(C) ]. + +otp_13277(doc) -> + ["PR 856. Fix a bc bug."]; +otp_13277(Config) -> + Test = <<"-module(t). + -export([t/0]). + + pad(A, L) -> + P = << <<\"#\">> || _ <- lists:seq(1, L) >>, + <<A/binary, P/binary>>. + + t() -> + pad(<<\"hi\">>, 2). + ">>, + ?line File = cc_mod(t, Test, Config), + ?line <<"hi##">> = t:t(), + ?line ok = file:delete(File), + ok. %%--Auxiliary------------------------------------------------------------ diff --git a/lib/tools/test/cover_SUITE_data/cc.erl b/lib/tools/test/cover_SUITE_data/cc.erl index 587bdbe493..7eb165ef8a 100644 --- a/lib/tools/test/cover_SUITE_data/cc.erl +++ b/lib/tools/test/cover_SUITE_data/cc.erl @@ -1,88 +1,17 @@ -module(cc). --export([epp/1, epp/2, dbg/1, dbg/2, cvr/1, cvr/2]). --export([p/2, pp/2]). +-compile(export_all). -%% epp(Module) - Creates Module.epp which contains all forms of Module -%% as obtained by using epp. -%% -%% dbg(Module) - Creates Module.dbg which contains all forms of Module -%% as obtained by using beam_lib:chunks/2. -%% -%% cvr(Module) - Creates Module.cvr which contains all forms of Module -%% as obtained by using cover:transform/3. -%% +%% This is a dummy module used only for cover compiling. The content +%% of this module has no meaning for the test. -epp(Module) -> - epp(Module, p). -epp(Module, P) -> - File = atom_to_list(Module)++".erl", - {ok,Cwd} = file:get_cwd(), - {ok, Fd1} = epp:open(File, [Cwd], []), - {ok, Fd2} = file:open(atom_to_list(Module)++".epp", write), +foo() -> + T = erlang:time(), + spawn(fun() -> bar(T) end). - epp(Fd1, Fd2, P), - - epp:close(Fd1), - file:close(Fd2), - ok. - -epp(Fd1, Fd2, P) -> - case epp:parse_erl_form(Fd1) of - {ok, {attribute,Line,Attr,Data}} -> - epp(Fd1, Fd2, P); - {ok, Form} when P==p -> - io:format(Fd2, "~p.~n", [Form]), - epp(Fd1, Fd2, P); - {ok, Form} when P==pp -> - io:format(Fd2, "~p.~n", [erl_pp:form(Form)]), - epp(Fd1, Fd2, P); - {eof, Line} -> - ok - end. - -cvr(Module) -> - cvr(Module, p). -cvr(Module, P) -> - case beam_lib:chunks(Module, [abstract_code]) of - {ok, {Module, [{abstract_code, no_abstract_code}]}} -> - {error, {no_debug_info,Module}}; - {ok, {Module, [{abstract_code, {Vsn, Forms}}]}} -> - Vars = {vars,Module,Vsn, [], - undefined, undefined, undefined, undefined, undefined, - undefined, - false}, - {ok, TForms, _Vars2} = cover:transform(Forms, [], Vars), - File = atom_to_list(Module)++".cvr", - apply(?MODULE, P, [File, TForms]); - Error -> - Error +bar(T) -> + receive + X -> + T1 = erlang:time(), + io:format("received ~p at ~p. Last time: ~p~n",[X,T1,T]), + bar(T1) end. - -dbg(Module) -> - dbg(Module, p). -dbg(Module, P) -> - case beam_lib:chunks(Module, [abstract_code]) of - {ok, {Module, [{abstract_code, no_abstract_code}]}} -> - {error, {no_debug_info,Module}}; - {ok, {Module, [{abstract_code, {Vsn, Forms}}]}} -> - File = atom_to_list(Module)++".dbg", - apply(?MODULE, P, [File, Forms]); - Error -> - Error - end. - -p(File, Forms) -> - {ok, Fd} = file:open(File, write), - lists:foreach(fun(Form) -> - io:format(Fd, "~p.~n", [Form]) - end, - Forms), - file:close(Fd). - -pp(File, Forms) -> - {ok, Fd} = file:open(File, write), - lists:foreach(fun(Form) -> - io:format(Fd, "~s", [erl_pp:form(Form)]) - end, - Forms), - file:close(Fd). diff --git a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc index 2bbe0eea1a..2c5caab07b 100644 --- a/lib/xmerl/src/xmerl_sax_parser_base.erlsrc +++ b/lib/xmerl/src/xmerl_sax_parser_base.erlsrc @@ -152,6 +152,7 @@ parse_document(Rest, State) when is_record(State, xmerl_sax_parser_state) -> %% [22] prolog ::= XMLDecl? Misc* (doctypedecl Misc*)? %% [23] XMLDecl ::= '<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>' %%---------------------------------------------------------------------- +-dialyzer({[no_fail_call, no_match], parse_xml_decl/2}). parse_xml_decl(?STRING_EMPTY, State) -> cf(?STRING_EMPTY, State, fun parse_xml_decl/2); parse_xml_decl(?BYTE_ORDER_MARK_1, State) -> @@ -1205,6 +1206,7 @@ send_character_event(_, true, String, State) -> %% Description: Parse whitespaces. %% [3] S ::= (#x20 | #x9 | #xD | #xA)+ %%---------------------------------------------------------------------- +-dialyzer({no_fail_call, whitespace/3}). whitespace(?STRING_EMPTY, State, Acc) -> case cf(?STRING_EMPTY, State, Acc, fun whitespace/3) of {?STRING_EMPTY, State} -> @@ -1716,6 +1718,7 @@ handle_external_entity({Tag, _Url}, State) -> %% Result : {Rest, State} %% Description: Parse the external entity. %%---------------------------------------------------------------------- +-dialyzer({[no_fail_call, no_match], parse_external_entity_1/2}). parse_external_entity_1(?STRING_EMPTY, #xmerl_sax_parser_state{file_type=Type} = State) -> case catch cf(?STRING_EMPTY, State, fun parse_external_entity_1/2) of {Rest, State1} when is_record(State1, xmerl_sax_parser_state) -> diff --git a/lib/xmerl/src/xmerl_scan.erl b/lib/xmerl/src/xmerl_scan.erl index 2bf3172d87..829716dcdb 100644 --- a/lib/xmerl/src/xmerl_scan.erl +++ b/lib/xmerl/src/xmerl_scan.erl @@ -1010,7 +1010,7 @@ scan_optional_version(T,S) -> scan_enc_name([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enc_name(MoreBytes, S1) end, - fun(S1) -> ?fatal(expected_encoding_name, S1) end, + fatal_fun(expected_encoding_name), S); scan_enc_name([H|T], S0) when H >= $"; H =< $' -> ?bump_col(1), @@ -1020,7 +1020,7 @@ scan_enc_name([H|T], S0) when H >= $"; H =< $' -> scan_enc_name([], S=#xmerl_scanner{continuation_fun = F}, Delim, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enc_name(MoreBytes, S1, Delim, Acc) end, - fun(S1) -> ?fatal(expected_encoding_name, S1) end, + fatal_fun(expected_encoding_name), S); scan_enc_name([H|T], S0, Delim, Acc) when H >= $a, H =< $z -> ?bump_col(1), @@ -1034,7 +1034,7 @@ scan_enc_name([H|_T],S,_Delim,_Acc) -> scan_enc_name2([], S=#xmerl_scanner{continuation_fun = F}, Delim, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enc_name2(MoreBytes, S1, Delim, Acc) end, - fun(S1) -> ?fatal(expected_encoding_name, S1) end, + fatal_fun(expected_encoding_name), S); scan_enc_name2([H|T], S0, H, Acc) -> ?bump_col(1), @@ -1058,7 +1058,7 @@ scan_enc_name2([H|T], S0, Delim, Acc) when H == $.; H == $_; H == $- -> scan_xml_vsn([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_xml_vsn(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_xml_vsn([H|T], S) when H==$"; H==$'-> xml_vsn(T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}, H, []). @@ -1066,7 +1066,7 @@ scan_xml_vsn([H|T], S) when H==$"; H==$'-> xml_vsn([], S=#xmerl_scanner{continuation_fun = F}, Delim, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> xml_vsn(MoreBytes, S1, Delim, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); xml_vsn([H|T], S=#xmerl_scanner{col = C}, H, Acc) -> {lists:reverse(Acc), T, S#xmerl_scanner{col = C+1}}; @@ -1089,7 +1089,7 @@ xml_vsn([H|T], S=#xmerl_scanner{col = C}, Delim, Acc) -> scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Pos, Ps) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Pos, Ps) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pi(Str = [H1,H2,H3 | T],S0=#xmerl_scanner{line = L, col = C}, Pos, Ps) when H1==$x;H1==$X -> @@ -1125,7 +1125,7 @@ scan_pi([], S=#xmerl_scanner{continuation_fun = F}, Target, ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pi(MoreBytes, S1, Target, L, C, Pos, Ps, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pi("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event}, @@ -1152,7 +1152,7 @@ scan_pi2([], S=#xmerl_scanner{continuation_fun = F}, Target, ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pi2(MoreBytes, S1, Target, L, C, Pos, Ps, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pi2("?>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event}, @@ -1180,7 +1180,7 @@ scan_pi2(Str, S0, Target, L, C, Pos, Ps, Acc) -> scan_doctype([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype(T, S) -> {_,T1,S1} = mandatory_strip(T,S), @@ -1194,7 +1194,7 @@ scan_doctype(T, S) -> scan_doctype1([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype1(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype1("PUBLIC" ++ T, S0) -> ?bump_col(6), @@ -1217,7 +1217,7 @@ scan_doctype1(T, S) -> scan_doctype2([], S=#xmerl_scanner{continuation_fun = F},DTD) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype2(MoreBytes, S1, DTD) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype2("[" ++ T, S0, DTD) -> ?bump_col(1), @@ -1237,7 +1237,7 @@ scan_doctype2(_T,S,_DTD) -> scan_doctype3([], S=#xmerl_scanner{continuation_fun = F},DTD) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_doctype3(MoreBytes, S1,DTD) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_doctype3("%" ++ T, S0, DTD) -> ?bump_col(1), @@ -1549,7 +1549,7 @@ scan_decl_sep(T,S) -> scan_conditional_sect([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_conditional_sect(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_conditional_sect("IGNORE" ++ T, S0) -> ?bump_col(6), @@ -1582,7 +1582,7 @@ scan_ignore(Str,S) -> scan_ignore([], S=#xmerl_scanner{continuation_fun = F},Level) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_ignore(MoreBytes, S1,Level) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_ignore("<![" ++ T, S0,Level) -> %% nested conditional section. Topmost condition is ignore, though @@ -1603,7 +1603,7 @@ scan_ignore([_H|T],S0,Level) -> scan_include([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_include(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_include("]]>" ++ T, S0) -> ?bump_col(3), @@ -1745,7 +1745,7 @@ update_attributes1([],Acc) -> scan_attdef([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_attdef(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_attdef(T, S) -> scan_attdef(T, S, _AttrAcc = []). @@ -1754,7 +1754,7 @@ scan_attdef(T, S) -> scan_attdef([], S=#xmerl_scanner{continuation_fun = F}, Attrs) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_attdef(MoreBytes, S1, Attrs) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_attdef(">" ++ T, S0, Attrs) -> ?bump_col(1), @@ -1798,7 +1798,7 @@ scan_attdef2(T, S, Attrs) -> scan_att_type([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_att_type(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_att_type("CDATA" ++ T, S0) -> ?bump_col(5), @@ -1856,7 +1856,7 @@ scan_att_type("%" ++ T, S0) -> scan_notation_type([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_notation_type(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_notation_type(")" ++ T, S0, Acc) -> ?bump_col(1), @@ -1889,7 +1889,7 @@ notation_exists(Name, #xmerl_scanner{rules_read_fun = Read, scan_enumeration([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_enumeration(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_enumeration(")" ++ T, S0, Acc) -> ?bump_col(1), @@ -1907,7 +1907,7 @@ scan_enumeration("|" ++ T, S0, Acc) -> scan_default_decl([], S=#xmerl_scanner{continuation_fun = F}, Type) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_default_decl(MoreBytes, S1, Type) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_default_decl("#REQUIRED" ++ T, S0, _Type) -> ?bump_col(9), @@ -1936,7 +1936,7 @@ default_value(T, S, Type) -> scan_entity([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_entity(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity("%" ++ T, #xmerl_scanner{rules_write_fun = Write} = S0) -> %% parameter entity @@ -1974,7 +1974,7 @@ scan_entity_completion(T,S) -> scan_entity_def([], S=#xmerl_scanner{continuation_fun = F}, EName) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_entity_def(MoreBytes, S1, EName) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity_def("'" ++ T, S0, EName) -> ?bump_col(1), @@ -2015,7 +2015,7 @@ scan_entity_def(Str, S, EName) -> scan_ndata_decl([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_ndata_decl(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_ndata_decl(Str = ">"++_T, S) -> {[], Str, S}; @@ -2062,7 +2062,7 @@ scan_element("/", S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_element("/" ++ MoreBytes, S1, Pos, Name, StartL, StartC, Attrs, Lang,Parents,NSI,NS,SpaceDefault) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_element([], S=#xmerl_scanner{continuation_fun = F}, Pos, Name, StartL, StartC, Attrs, Lang, Parents, @@ -2071,7 +2071,7 @@ scan_element([], S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_element(MoreBytes, S1, Pos, Name, StartL, StartC, Attrs, Lang,Parents,NSI,NS,SpaceDefault) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_element("/>" ++ T, S0 = #xmerl_scanner{hook_fun = Hook, event_fun = Event, @@ -2099,7 +2099,7 @@ scan_element(">", S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_element(">" ++ MoreBytes, S1, Pos, Name, StartL, StartC, Attrs, Lang,Parents,NSI,NS,SpaceDefault) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_element(">" ++ T, S0 = #xmerl_scanner{event_fun = Event, hook_fun = Hook, @@ -2344,7 +2344,7 @@ keyreplaceadd(_K, _Pos, [], Obj) -> scan_att_value([], S=#xmerl_scanner{continuation_fun = F},AT) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_att_value(MoreBytes, S1, AT) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_att_value("%"++_T,S=#xmerl_scanner{environment=prolog},_AttType) -> ?fatal({error,{wfc_PEs_In_Internal_Subset}},S); @@ -2385,7 +2385,7 @@ scan_att_chars([],S=#xmerl_scanner{continuation_fun=F},H,Acc,TmpAcc,AT,IsNorm)-> F(fun(MoreBytes, S1) -> scan_att_chars(MoreBytes, S1, H, Acc,TmpAcc,AT,IsNorm) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_att_chars([H|T], S0, H, Acc, TmpAcc,AttType,IsNorm) -> % End quote ?bump_col(1), @@ -2518,7 +2518,7 @@ scan_content("<", S= #xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_content("<" ++ MoreBytes, S1, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_content([], S=#xmerl_scanner{environment={external,{entity,_}}}, _Pos, _Name, _Attrs, _Space, _Lang, _Parents, _NS, Acc,_) -> @@ -2532,7 +2532,7 @@ scan_content([], S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_content(MoreBytes, S1, Pos, Name, Attrs, Space, Lang, Parents, NS, Acc,[]) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_content("</" ++ T, S0, _Pos, Name, _Attrs, _Space, _Lang, _Parents, _NS, Acc,[]) -> @@ -2636,7 +2636,7 @@ scan_content_markup([], S=#xmerl_scanner{continuation_fun = F}, F(fun(MoreBytes, S1) -> scan_content_markup( MoreBytes,S1,Pos,Name, Attrs,Space,Lang,Parents,NS) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_content_markup("![CDATA[" ++ T, S0, Pos, _Name, _Attrs, _Space, _Lang, Parents, _NS) -> @@ -2664,7 +2664,7 @@ scan_char_data([], S=#xmerl_scanner{environment=internal_parsed_entity}, scan_char_data([], S=#xmerl_scanner{continuation_fun = F}, Space, _MUD,Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_char_data(MoreBytes,S1,Space,_MUD,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_char_data([$&|T], S,Space,"&",Acc) -> scan_char_data(T, S, Space,[], [$&|Acc]); @@ -2716,7 +2716,7 @@ scan_cdata(Str, S, Pos, Parents) -> scan_cdata([], S=#xmerl_scanner{continuation_fun = F}, Pos, Parents, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_cdata(MoreBytes, S1, Pos, Parents, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_cdata("]]>" ++ T, S0, Pos, Parents, Acc) -> ?bump_col(3), @@ -2741,7 +2741,7 @@ scan_cdata(Str, S0, Pos, Parents, Acc) -> scan_reference([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_reference(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_reference("#x" ++ T, S0) -> %% [66] CharRef @@ -2783,7 +2783,7 @@ scan_reference(T, S) -> scan_entity_ref([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_entity_ref(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity_ref("amp;" ++ T, S0) -> ?bump_col(4), @@ -2868,7 +2868,7 @@ expand_reference(Name, #xmerl_scanner{rules_read_fun = Read} = S) -> scan_char_ref_dec([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_char_ref_dec(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_char_ref_dec([H|T], S0, Acc) when H >= $0, H =< $9 -> ?bump_col(1), @@ -2883,7 +2883,7 @@ scan_char_ref_dec(";" ++ T, S0, Acc) -> scan_char_ref_hex([], S=#xmerl_scanner{continuation_fun = F}, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_char_ref_hex(MoreBytes, S1, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_char_ref_hex([H|T], S0, Acc) when H >= $0, H =< $9 -> ?bump_col(1), @@ -2957,7 +2957,7 @@ scan_name_no_colons(Str, S) -> scan_name([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_name(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_name(Str = [$:|T], S0 = #xmerl_scanner{namespace_conformant = NSC}) -> if NSC == false -> @@ -3007,7 +3007,7 @@ scan_nmtoken(Str, S, Acc, NSC) -> scan_nmtoken([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_nmtoken(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_nmtoken("%"++T, S0=#xmerl_scanner{environment={external,_}}) -> ?bump_col(1), @@ -3084,7 +3084,7 @@ isLatin1(_,_) -> scan_system_literal([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_system_literal(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_system_literal("\"" ++ T, S) -> scan_system_literal(T, S, $", []); @@ -3096,7 +3096,7 @@ scan_system_literal([], S=#xmerl_scanner{continuation_fun = F}, Delimiter, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_system_literal(MoreBytes,S1,Delimiter,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_system_literal([H|T], S, H, Acc) -> {lists:reverse(Acc), T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}}; @@ -3114,7 +3114,7 @@ scan_system_literal(Str, S, Delimiter, Acc) -> scan_pubid_literal([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pubid_literal(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pubid_literal([H|T], S) when H == $"; H == $' -> scan_pubid_literal(T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}, H, []); @@ -3126,7 +3126,7 @@ scan_pubid_literal([], S=#xmerl_scanner{continuation_fun = F}, Delimiter, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pubid_literal(MoreBytes,S1,Delimiter,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pubid_literal([H|T], S, H, Acc) -> {lists:reverse(Acc), T, S#xmerl_scanner{col = S#xmerl_scanner.col+1}}; @@ -3161,7 +3161,7 @@ is_pubid_char(X) -> scan_contentspec([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_contentspec(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_contentspec("EMPTY" ++ T, S0) -> ?bump_col(5), @@ -3195,7 +3195,7 @@ scan_elem_content([], S=#xmerl_scanner{continuation_fun = F}, Context, Mode, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes,S1) -> scan_elem_content(MoreBytes,S1,Context,Mode,Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_elem_content(")" ++ T, S0, Context, Mode0, Acc0) -> ?bump_col(1), @@ -3282,7 +3282,7 @@ format_elem_content(Other) -> Other. scan_occurrence([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_occurrence(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_occurrence([$?|T], S0) -> ?bump_col(1), @@ -3433,7 +3433,7 @@ wfc_whitespace_betw_attrs([$> |_]=L,S) -> wfc_whitespace_betw_attrs([],S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> wfc_whitespace_betw_attrs(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); wfc_whitespace_betw_attrs(_,S) -> ?fatal({whitespace_required_between_attributes},S). @@ -3477,7 +3477,7 @@ vc_Element_valid(_,_) -> scan_pe_def([], S=#xmerl_scanner{continuation_fun = F}, PEName) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_pe_def(MoreBytes, S1, PEName) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_pe_def("'" ++ T, S0, PEName) -> ?bump_col(1), @@ -3510,7 +3510,7 @@ scan_notation_decl(T, #xmerl_scanner{rules_write_fun = Write, scan_notation_decl1([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_notation_decl1(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_notation_decl1("SYSTEM" ++ T, S0) -> ?bump_col(6), @@ -3536,7 +3536,7 @@ scan_notation_decl1("PUBLIC" ++ T, S0) -> scan_external_id([], S=#xmerl_scanner{continuation_fun = F}) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_external_id(MoreBytes, S1) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_external_id("SYSTEM" ++ T, S0) -> ?bump_col(6), @@ -3582,7 +3582,7 @@ scan_entity_value([], S=#xmerl_scanner{continuation_fun = F}, scan_entity_value(MoreBytes,S1, Delim,Acc,PEName,Namespace,PENesting) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_entity_value([Delim|T], S=#xmerl_scanner{validation=dtd}, Delim,_Acc,PEName,_NS,PENesting) when length(PENesting) /= 0 -> @@ -3850,7 +3850,7 @@ scan_comment1([], S=#xmerl_scanner{continuation_fun = F}, Pos, Comment, Acc) -> ?dbg("cont()...~n", []), F(fun(MoreBytes, S1) -> scan_comment1(MoreBytes, S1, Pos, Comment, Acc) end, - fun(S1) -> ?fatal(unexpected_end, S1) end, + fatal_fun(unexpected_end), S); scan_comment1("-->" ++ T, S0 = #xmerl_scanner{col = C, event_fun = Event, @@ -4100,6 +4100,13 @@ handle_schema_result({error,Reason},S5) -> %%% Helper functions +-compile({inline, [fatal_fun/1]}). + +-spec fatal_fun(_) -> fun((_) -> no_return()). + +fatal_fun(Reason) -> + fun(S) -> ?fatal(Reason, S) end. + fatal(Reason, S) -> exit({fatal, {Reason, {file,S#xmerl_scanner.filename}, |