aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/asn1/src/asn1ct_gen.erl1
-rw-r--r--lib/asn1/src/asn1ct_imm.erl33
-rw-r--r--lib/asn1/test/asn1_SUITE_data/Prim.asn17
-rw-r--r--lib/asn1/test/asn1_test_lib.erl2
-rw-r--r--lib/asn1/test/testPrim.erl29
-rw-r--r--lib/compiler/src/beam_bool.erl50
-rw-r--r--lib/compiler/src/beam_bsm.erl5
-rw-r--r--lib/compiler/src/cerl.erl11
-rw-r--r--lib/compiler/src/v3_codegen.erl58
-rw-r--r--lib/compiler/src/v3_core.erl2
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl32
-rw-r--r--lib/compiler/test/guard_SUITE.erl79
-rw-r--r--lib/compiler/test/map_SUITE.erl3
-rw-r--r--lib/crypto/c_src/crypto.c8
-rw-r--r--lib/crypto/test/crypto_SUITE.erl220
-rw-r--r--lib/crypto/test/old_crypto_SUITE.erl44
-rw-r--r--lib/dialyzer/src/dialyzer_analysis_callgraph.erl46
-rw-r--r--lib/dialyzer/src/dialyzer_callgraph.erl27
-rw-r--r--lib/dialyzer/src/dialyzer_cl.erl57
-rw-r--r--lib/dialyzer/src/dialyzer_options.erl36
-rw-r--r--lib/dialyzer/src/dialyzer_plt.erl2
-rw-r--r--lib/dialyzer/test/plt_SUITE.erl95
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/comparisons228
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/fun_arity2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/maps14
-rw-r--r--lib/dialyzer/test/small_SUITE_data/results/non_existing1
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/comparisons.erl56
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/maps1.erl12
-rw-r--r--lib/diameter/doc/src/diameter.xml22
-rw-r--r--lib/diameter/src/base/diameter_service.erl9
-rw-r--r--lib/diameter/src/diameter.appup.src4
-rw-r--r--lib/diameter/test/diameter_traffic_SUITE.erl3
-rw-r--r--lib/edoc/doc/overview.edoc7
-rw-r--r--lib/edoc/src/edoc.erl2
-rw-r--r--lib/edoc/src/edoc_layout.erl8
-rw-r--r--lib/edoc/src/edoc_specs.erl6
-rw-r--r--lib/erl_docgen/src/docgen_otp_specs.erl4
-rw-r--r--lib/hipe/cerl/cerl_prettypr.erl18
-rw-r--r--lib/hipe/cerl/cerl_to_icode.erl8
-rw-r--r--lib/hipe/cerl/erl_bif_types.erl6
-rw-r--r--lib/hipe/cerl/erl_types.erl14
-rw-r--r--lib/hipe/icode/hipe_beam_to_icode.erl51
-rw-r--r--lib/hipe/icode/hipe_icode_primops.erl37
-rw-r--r--lib/hipe/icode/hipe_icode_range.erl6
-rw-r--r--lib/hipe/rtl/hipe_rtl_arith.inc15
-rw-r--r--lib/hipe/rtl/hipe_rtl_arith_32.erl3
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary.erl144
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary_construct.erl196
-rw-r--r--lib/hipe/rtl/hipe_rtl_binary_match.erl151
-rw-r--r--lib/hipe/rtl/hipe_tagscheme.erl23
-rw-r--r--lib/hipe/test/Makefile4
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_arith.erl72
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl102
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bifs.erl257
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bignums.erl143
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_boolean.erl47
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl138
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl463
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_comparisons.erl157
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_exceptions.erl465
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_floats.erl180
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_fun.erl124
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_guards.erl164
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_inline_function.erl73
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_inline_module.erl31
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl326
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl153
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_lists.erl61
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_module_info.erl32
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl46
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_random.erl238
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_receive.erl56
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_records.erl28
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl65
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_switches.erl52
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl39
-rw-r--r--lib/hipe/test/basic_SUITE_data/basic_tuples.erl177
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_add.erl10
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_construct.erl161
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_split.erl10
-rw-r--r--lib/hipe/test/bs_SUITE_data/bs_utf.erl344
-rw-r--r--lib/hipe/test/hipe_testsuite_driver.erl16
-rw-r--r--lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl28
-rw-r--r--lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl21
-rw-r--r--lib/inets/doc/src/notes.xml18
-rw-r--r--lib/inets/src/http_client/httpc.erl7
-rw-r--r--lib/inets/src/http_client/httpc_request.erl3
-rw-r--r--lib/inets/src/http_lib/http_uri.erl8
-rw-r--r--lib/inets/src/http_server/httpd.erl18
-rw-r--r--lib/inets/src/http_server/httpd_conf.erl34
-rw-r--r--lib/inets/src/http_server/httpd_request.erl5
-rw-r--r--lib/inets/src/http_server/httpd_script_env.erl2
-rw-r--r--lib/inets/src/http_server/httpd_util.erl29
-rw-r--r--lib/inets/src/http_server/mod_actions.erl20
-rw-r--r--lib/inets/src/http_server/mod_alias.erl70
-rw-r--r--lib/inets/src/http_server/mod_auth.erl40
-rw-r--r--lib/inets/src/http_server/mod_auth_plain.erl14
-rw-r--r--lib/inets/src/http_server/mod_browser.erl21
-rw-r--r--lib/inets/src/http_server/mod_cgi.erl2
-rw-r--r--lib/inets/src/http_server/mod_dir.erl11
-rw-r--r--lib/inets/src/http_server/mod_disk_log.erl25
-rw-r--r--lib/inets/src/http_server/mod_esi.erl40
-rw-r--r--lib/inets/src/http_server/mod_htaccess.erl35
-rw-r--r--lib/inets/src/http_server/mod_security.erl8
-rw-r--r--lib/inets/src/inets_app/Makefile1
-rw-r--r--lib/inets/src/inets_app/inets.app.src1
-rw-r--r--lib/inets/src/inets_app/inets_regexp.erl414
-rw-r--r--lib/inets/src/tftp/tftp_engine.erl4
-rw-r--r--lib/inets/src/tftp/tftp_lib.erl4
-rw-r--r--lib/inets/test/httpc_SUITE.erl23
-rw-r--r--lib/inets/test/httpd_1_1.erl42
-rw-r--r--lib/inets/test/httpd_poll.erl6
-rw-r--r--lib/inets/test/httpd_test_lib.erl10
-rw-r--r--lib/inets/test/httpd_time_test.erl22
-rw-r--r--lib/inets/vsn.mk2
-rw-r--r--lib/kernel/doc/src/code.xml61
-rw-r--r--lib/kernel/doc/src/net_kernel.xml13
-rw-r--r--lib/kernel/doc/src/seq_trace.xml29
-rw-r--r--lib/kernel/src/code.erl9
-rw-r--r--lib/kernel/src/code_server.erl9
-rw-r--r--lib/kernel/src/kernel.app.src2
-rw-r--r--lib/kernel/src/seq_trace.erl14
-rw-r--r--lib/kernel/test/code_SUITE.erl12
-rw-r--r--lib/kernel/test/code_SUITE_data/on_load_errors/simple_on_load_error.erl5
-rw-r--r--lib/kernel/test/seq_trace_SUITE.erl166
-rw-r--r--lib/mnesia/src/mnesia_controller.erl18
-rw-r--r--lib/mnesia/src/mnesia_loader.erl36
-rw-r--r--lib/mnesia/src/mnesia_locker.erl20
-rw-r--r--lib/mnesia/src/mnesia_monitor.erl8
-rw-r--r--lib/mnesia/src/mnesia_schema.erl182
-rw-r--r--lib/mnesia/test/mnesia_isolation_test.erl71
-rw-r--r--lib/runtime_tools/src/dbg.erl4
-rw-r--r--lib/sasl/doc/src/overload.xml6
-rw-r--r--lib/sasl/doc/src/sasl_app.xml6
-rw-r--r--lib/sasl/src/overload.erl2
-rw-r--r--lib/sasl/src/release_handler_1.erl100
-rw-r--r--lib/sasl/src/sasl.app.src2
-rw-r--r--lib/sasl/test/release_handler_SUITE.erl2
-rw-r--r--lib/snmp/src/agent/snmp_view_based_acm_mib.erl2
-rw-r--r--lib/snmp/src/agent/snmpa_acm.erl4
-rw-r--r--lib/snmp/src/app/snmp.appup.src67
-rw-r--r--lib/ssh/doc/src/notes.xml18
-rw-r--r--lib/ssh/src/ssh_auth.erl2
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl6
-rw-r--r--lib/ssh/test/Makefile5
-rw-r--r--lib/ssh/test/ssh.spec11
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl8
-rw-r--r--lib/ssh/test/ssh_bench.spec1
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE.erl539
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/id_dsa13
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa2565
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa256.pub1
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa3846
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa384.pub1
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa5217
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/id_ecdsa521.pub1
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/id_rsa15
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key13
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_dsa_key.pub11
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key2565
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key256.pub1
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key3846
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key384.pub1
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key5217
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_ecdsa_key521.pub1
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key16
-rw-r--r--lib/ssh/test/ssh_benchmark_SUITE_data/ssh_host_rsa_key.pub5
-rw-r--r--lib/ssh/test/ssh_protocol_SUITE.erl128
-rw-r--r--lib/ssh/test/ssh_test_cli.erl15
-rw-r--r--lib/ssh/test/ssh_test_lib.erl35
-rw-r--r--lib/ssh/test/ssh_to_openssh_SUITE.erl4
-rw-r--r--lib/ssh/vsn.mk2
-rw-r--r--lib/ssl/src/inet_tls_dist.erl12
-rw-r--r--lib/ssl/src/ssl.appup.src6
-rw-r--r--lib/ssl/src/ssl_manager.erl24
-rw-r--r--lib/ssl/src/ssl_record.erl16
-rw-r--r--lib/ssl/src/ssl_tls_dist_proxy.erl54
-rw-r--r--lib/ssl/src/tls_connection.erl2
-rw-r--r--lib/ssl/test/erl_make_certs.erl4
-rw-r--r--lib/ssl/test/ssl_dist_SUITE.erl91
-rw-r--r--lib/ssl/test/ssl_test_lib.erl74
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl39
-rw-r--r--lib/ssl/vsn.mk2
-rw-r--r--lib/stdlib/doc/src/dets.xml31
-rw-r--r--lib/stdlib/doc/src/ets.xml41
-rw-r--r--lib/stdlib/doc/src/supervisor.xml5
-rw-r--r--lib/stdlib/src/beam_lib.erl5
-rw-r--r--lib/stdlib/src/dets.erl36
-rw-r--r--lib/stdlib/src/edlin.erl1
-rw-r--r--lib/stdlib/src/erl_eval.erl33
-rw-r--r--lib/stdlib/src/erl_lint.erl6
-rw-r--r--lib/stdlib/src/ets.erl2
-rw-r--r--lib/stdlib/src/otp_internal.erl3
-rw-r--r--lib/stdlib/src/stdlib.app.src2
-rw-r--r--lib/stdlib/src/supervisor.erl63
-rw-r--r--lib/stdlib/test/dets_SUITE.erl24
-rw-r--r--lib/stdlib/test/erl_eval_SUITE.erl23
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl15
-rw-r--r--lib/stdlib/test/ets_SUITE.erl35
-rw-r--r--lib/stdlib/test/supervisor_SUITE.erl52
-rw-r--r--lib/stdlib/test/supervisor_deadlock.erl14
-rw-r--r--lib/tools/src/cover.erl74
-rw-r--r--lib/tools/src/lcnt.erl1
-rw-r--r--lib/tools/test/cover_SUITE.erl95
-rw-r--r--lib/tools/test/cover_SUITE_data/cc.erl95
205 files changed, 7630 insertions, 2198 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/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/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/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/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..1bd8703e1d 100644
--- a/lib/mnesia/src/mnesia_schema.erl
+++ b/lib/mnesia/src/mnesia_schema.erl
@@ -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),
@@ -1297,6 +1250,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 +1278,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 +1310,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 +1922,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 +1953,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 +2171,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 +2321,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 +2794,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/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl
index d2a7d734c1..22b531e6ee 100644
--- a/lib/runtime_tools/src/dbg.erl
+++ b/lib/runtime_tools/src/dbg.erl
@@ -1269,7 +1269,7 @@ 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 ->
@@ -1294,7 +1294,7 @@ 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 ->
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/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_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_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/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..e940ad6956 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);
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/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 2d77888512..c254ab1e46 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -648,6 +648,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.
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/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/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/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/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).