diff options
Diffstat (limited to 'lib')
152 files changed, 7001 insertions, 1803 deletions
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl index 58bb18e34a..b86be95cab 100644 --- a/lib/compiler/src/cerl_trees.erl +++ b/lib/compiler/src/cerl_trees.erl @@ -27,7 +27,7 @@ -module(cerl_trees). -export([depth/1, fold/3, free_variables/1, get_label/1, label/1, label/2, - map/2, mapfold/3, size/1, variables/1]). + map/2, mapfold/3, mapfold/4, size/1, variables/1]). -import(cerl, [alias_pat/1, alias_var/1, ann_c_alias/3, ann_c_apply/3, ann_c_binary/2, ann_c_bitstr/6, ann_c_call/4, @@ -340,136 +340,162 @@ fold_pairs(_, S, []) -> %% starting with the given value <code>Initial</code>, while doing a %% post-order traversal of the tree, much like <code>fold/3</code>. %% +%% This is the same as mapfold/4, with an identity function as the +%% pre-operation. +%% %% @see map/2 %% @see fold/3 +%% @see mapfold/4 -spec mapfold(fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}), term(), cerl:cerl()) -> {cerl:cerl(), term()}. mapfold(F, S0, T) -> + mapfold(fun(T0, A) -> {T0, A} end, F, S0, T). + + +%% @spec mapfold(Pre, Post, Initial::term(), Tree::cerl()) -> +%% {cerl(), term()} +%% +%% Pre = Post = (cerl(), term()) -> {cerl(), term()} +%% +%% @doc Does a combined map/fold operation on the nodes of the +%% tree. It begins by calling <code>Pre</code> on the tree, using the +%% <code>Initial</code> value. It then deconstructs the top node of +%% the returned tree and recurses on the children, using the returned +%% value as the new initial and carrying the returned values from one +%% call to the next. Finally it reassembles the top node from the +%% children, calls <code>Post</code> on it and returns the result. + +-spec mapfold(fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}), + fun((cerl:cerl(), term()) -> {cerl:cerl(), term()}), + term(), cerl:cerl()) -> {cerl:cerl(), term()}. + +mapfold(Pre, Post, S00, T0) -> + {T, S0} = Pre(T0, S00), case type(T) of literal -> case concrete(T) of [_ | _] -> - {T1, S1} = mapfold(F, S0, cons_hd(T)), - {T2, S2} = mapfold(F, S1, cons_tl(T)), - F(update_c_cons(T, T1, T2), S2); + {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)), + {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)), + Post(update_c_cons(T, T1, T2), S2); V when tuple_size(V) > 0 -> - {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), - F(update_c_tuple(T, Ts), S1); + {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)), + Post(update_c_tuple(T, Ts), S1); _ -> - F(T, S0) + Post(T, S0) end; var -> - F(T, S0); + Post(T, S0); values -> - {Ts, S1} = mapfold_list(F, S0, values_es(T)), - F(update_c_values(T, Ts), S1); + {Ts, S1} = mapfold_list(Pre, Post, S0, values_es(T)), + Post(update_c_values(T, Ts), S1); cons -> - {T1, S1} = mapfold(F, S0, cons_hd(T)), - {T2, S2} = mapfold(F, S1, cons_tl(T)), - F(update_c_cons_skel(T, T1, T2), S2); + {T1, S1} = mapfold(Pre, Post, S0, cons_hd(T)), + {T2, S2} = mapfold(Pre, Post, S1, cons_tl(T)), + Post(update_c_cons_skel(T, T1, T2), S2); tuple -> - {Ts, S1} = mapfold_list(F, S0, tuple_es(T)), - F(update_c_tuple_skel(T, Ts), S1); + {Ts, S1} = mapfold_list(Pre, Post, S0, tuple_es(T)), + Post(update_c_tuple_skel(T, Ts), S1); map -> - {M , S1} = mapfold(F, S0, map_arg(T)), - {Ts, S2} = mapfold_list(F, S1, map_es(T)), - F(update_c_map(T, M, Ts), S2); + {M , S1} = mapfold(Pre, Post, S0, map_arg(T)), + {Ts, S2} = mapfold_list(Pre, Post, S1, map_es(T)), + Post(update_c_map(T, M, Ts), S2); map_pair -> - {Op, S1} = mapfold(F, S0, map_pair_op(T)), - {Key, S2} = mapfold(F, S1, map_pair_key(T)), - {Val, S3} = mapfold(F, S2, map_pair_val(T)), - F(update_c_map_pair(T,Op,Key,Val), S3); + {Op, S1} = mapfold(Pre, Post, S0, map_pair_op(T)), + {Key, S2} = mapfold(Pre, Post, S1, map_pair_key(T)), + {Val, S3} = mapfold(Pre, Post, S2, map_pair_val(T)), + Post(update_c_map_pair(T,Op,Key,Val), S3); 'let' -> - {Vs, S1} = mapfold_list(F, S0, let_vars(T)), - {A, S2} = mapfold(F, S1, let_arg(T)), - {B, S3} = mapfold(F, S2, let_body(T)), - F(update_c_let(T, Vs, A, B), S3); + {Vs, S1} = mapfold_list(Pre, Post, S0, let_vars(T)), + {A, S2} = mapfold(Pre, Post, S1, let_arg(T)), + {B, S3} = mapfold(Pre, Post, S2, let_body(T)), + Post(update_c_let(T, Vs, A, B), S3); seq -> - {A, S1} = mapfold(F, S0, seq_arg(T)), - {B, S2} = mapfold(F, S1, seq_body(T)), - F(update_c_seq(T, A, B), S2); + {A, S1} = mapfold(Pre, Post, S0, seq_arg(T)), + {B, S2} = mapfold(Pre, Post, S1, seq_body(T)), + Post(update_c_seq(T, A, B), S2); apply -> - {E, S1} = mapfold(F, S0, apply_op(T)), - {As, S2} = mapfold_list(F, S1, apply_args(T)), - F(update_c_apply(T, E, As), S2); + {E, S1} = mapfold(Pre, Post, S0, apply_op(T)), + {As, S2} = mapfold_list(Pre, Post, S1, apply_args(T)), + Post(update_c_apply(T, E, As), S2); call -> - {M, S1} = mapfold(F, S0, call_module(T)), - {N, S2} = mapfold(F, S1, call_name(T)), - {As, S3} = mapfold_list(F, S2, call_args(T)), - F(update_c_call(T, M, N, As), S3); + {M, S1} = mapfold(Pre, Post, S0, call_module(T)), + {N, S2} = mapfold(Pre, Post, S1, call_name(T)), + {As, S3} = mapfold_list(Pre, Post, S2, call_args(T)), + Post(update_c_call(T, M, N, As), S3); primop -> - {N, S1} = mapfold(F, S0, primop_name(T)), - {As, S2} = mapfold_list(F, S1, primop_args(T)), - F(update_c_primop(T, N, As), S2); + {N, S1} = mapfold(Pre, Post, S0, primop_name(T)), + {As, S2} = mapfold_list(Pre, Post, S1, primop_args(T)), + Post(update_c_primop(T, N, As), S2); 'case' -> - {A, S1} = mapfold(F, S0, case_arg(T)), - {Cs, S2} = mapfold_list(F, S1, case_clauses(T)), - F(update_c_case(T, A, Cs), S2); + {A, S1} = mapfold(Pre, Post, S0, case_arg(T)), + {Cs, S2} = mapfold_list(Pre, Post, S1, case_clauses(T)), + Post(update_c_case(T, A, Cs), S2); clause -> - {Ps, S1} = mapfold_list(F, S0, clause_pats(T)), - {G, S2} = mapfold(F, S1, clause_guard(T)), - {B, S3} = mapfold(F, S2, clause_body(T)), - F(update_c_clause(T, Ps, G, B), S3); + {Ps, S1} = mapfold_list(Pre, Post, S0, clause_pats(T)), + {G, S2} = mapfold(Pre, Post, S1, clause_guard(T)), + {B, S3} = mapfold(Pre, Post, S2, clause_body(T)), + Post(update_c_clause(T, Ps, G, B), S3); alias -> - {V, S1} = mapfold(F, S0, alias_var(T)), - {P, S2} = mapfold(F, S1, alias_pat(T)), - F(update_c_alias(T, V, P), S2); + {V, S1} = mapfold(Pre, Post, S0, alias_var(T)), + {P, S2} = mapfold(Pre, Post, S1, alias_pat(T)), + Post(update_c_alias(T, V, P), S2); 'fun' -> - {Vs, S1} = mapfold_list(F, S0, fun_vars(T)), - {B, S2} = mapfold(F, S1, fun_body(T)), - F(update_c_fun(T, Vs, B), S2); + {Vs, S1} = mapfold_list(Pre, Post, S0, fun_vars(T)), + {B, S2} = mapfold(Pre, Post, S1, fun_body(T)), + Post(update_c_fun(T, Vs, B), S2); 'receive' -> - {Cs, S1} = mapfold_list(F, S0, receive_clauses(T)), - {E, S2} = mapfold(F, S1, receive_timeout(T)), - {A, S3} = mapfold(F, S2, receive_action(T)), - F(update_c_receive(T, Cs, E, A), S3); + {Cs, S1} = mapfold_list(Pre, Post, S0, receive_clauses(T)), + {E, S2} = mapfold(Pre, Post, S1, receive_timeout(T)), + {A, S3} = mapfold(Pre, Post, S2, receive_action(T)), + Post(update_c_receive(T, Cs, E, A), S3); 'try' -> - {E, S1} = mapfold(F, S0, try_arg(T)), - {Vs, S2} = mapfold_list(F, S1, try_vars(T)), - {B, S3} = mapfold(F, S2, try_body(T)), - {Evs, S4} = mapfold_list(F, S3, try_evars(T)), - {H, S5} = mapfold(F, S4, try_handler(T)), - F(update_c_try(T, E, Vs, B, Evs, H), S5); + {E, S1} = mapfold(Pre, Post, S0, try_arg(T)), + {Vs, S2} = mapfold_list(Pre, Post, S1, try_vars(T)), + {B, S3} = mapfold(Pre, Post, S2, try_body(T)), + {Evs, S4} = mapfold_list(Pre, Post, S3, try_evars(T)), + {H, S5} = mapfold(Pre, Post, S4, try_handler(T)), + Post(update_c_try(T, E, Vs, B, Evs, H), S5); 'catch' -> - {B, S1} = mapfold(F, S0, catch_body(T)), - F(update_c_catch(T, B), S1); + {B, S1} = mapfold(Pre, Post, S0, catch_body(T)), + Post(update_c_catch(T, B), S1); binary -> - {Ds, S1} = mapfold_list(F, S0, binary_segments(T)), - F(update_c_binary(T, Ds), S1); + {Ds, S1} = mapfold_list(Pre, Post, S0, binary_segments(T)), + Post(update_c_binary(T, Ds), S1); bitstr -> - {Val, S1} = mapfold(F, S0, bitstr_val(T)), - {Size, S2} = mapfold(F, S1, bitstr_size(T)), - {Unit, S3} = mapfold(F, S2, bitstr_unit(T)), - {Type, S4} = mapfold(F, S3, bitstr_type(T)), - {Flags, S5} = mapfold(F, S4, bitstr_flags(T)), - F(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5); + {Val, S1} = mapfold(Pre, Post, S0, bitstr_val(T)), + {Size, S2} = mapfold(Pre, Post, S1, bitstr_size(T)), + {Unit, S3} = mapfold(Pre, Post, S2, bitstr_unit(T)), + {Type, S4} = mapfold(Pre, Post, S3, bitstr_type(T)), + {Flags, S5} = mapfold(Pre, Post, S4, bitstr_flags(T)), + Post(update_c_bitstr(T, Val, Size, Unit, Type, Flags), S5); letrec -> - {Ds, S1} = mapfold_pairs(F, S0, letrec_defs(T)), - {B, S2} = mapfold(F, S1, letrec_body(T)), - F(update_c_letrec(T, Ds, B), S2); + {Ds, S1} = mapfold_pairs(Pre, Post, S0, letrec_defs(T)), + {B, S2} = mapfold(Pre, Post, S1, letrec_body(T)), + Post(update_c_letrec(T, Ds, B), S2); module -> - {N, S1} = mapfold(F, S0, module_name(T)), - {Es, S2} = mapfold_list(F, S1, module_exports(T)), - {As, S3} = mapfold_pairs(F, S2, module_attrs(T)), - {Ds, S4} = mapfold_pairs(F, S3, module_defs(T)), - F(update_c_module(T, N, Es, As, Ds), S4) + {N, S1} = mapfold(Pre, Post, S0, module_name(T)), + {Es, S2} = mapfold_list(Pre, Post, S1, module_exports(T)), + {As, S3} = mapfold_pairs(Pre, Post, S2, module_attrs(T)), + {Ds, S4} = mapfold_pairs(Pre, Post, S3, module_defs(T)), + Post(update_c_module(T, N, Es, As, Ds), S4) end. -mapfold_list(F, S0, [T | Ts]) -> - {T1, S1} = mapfold(F, S0, T), - {Ts1, S2} = mapfold_list(F, S1, Ts), +mapfold_list(Pre, Post, S0, [T | Ts]) -> + {T1, S1} = mapfold(Pre, Post, S0, T), + {Ts1, S2} = mapfold_list(Pre, Post, S1, Ts), {[T1 | Ts1], S2}; -mapfold_list(_, S, []) -> +mapfold_list(_, _, S, []) -> {[], S}. -mapfold_pairs(F, S0, [{T1, T2} | Ps]) -> - {T3, S1} = mapfold(F, S0, T1), - {T4, S2} = mapfold(F, S1, T2), - {Ps1, S3} = mapfold_pairs(F, S2, Ps), +mapfold_pairs(Pre, Post, S0, [{T1, T2} | Ps]) -> + {T3, S1} = mapfold(Pre, Post, S0, T1), + {T4, S2} = mapfold(Pre, Post, S1, T2), + {Ps1, S3} = mapfold_pairs(Pre, Post, S2, Ps), {[{T3, T4} | Ps1], S3}; -mapfold_pairs(_, S, []) -> +mapfold_pairs(_, _, S, []) -> {[], S}. @@ -640,8 +666,8 @@ vars_in_list([], _, A) -> vars_in_defs(Ds, S) -> vars_in_defs(Ds, S, []). -vars_in_defs([{_, F} | Ds], S, A) -> - vars_in_defs(Ds, S, ordsets:union(variables(F, S), A)); +vars_in_defs([{_, Post} | Ds], S, A) -> + vars_in_defs(Ds, S, ordsets:union(variables(Post, S), A)); vars_in_defs([], _, A) -> A. @@ -703,13 +729,14 @@ label(T, N, Env) -> %% Constant literals are not labeled. {T, N}; var -> - case dict:find(var_name(T), Env) of - {ok, L} -> - {As, _} = label_ann(T, L), - N1 = N; - error -> - {As, N1} = label_ann(T, N) - end, + {As, N1} = + case dict:find(var_name(T), Env) of + {ok, L} -> + {A, _} = label_ann(T, L), + {A, N}; + error -> + label_ann(T, N) + end, {set_ann(T, As), N1}; values -> {Ts, N1} = label_list(values_es(T), N, Env), diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index 3fd34241b2..619db125b1 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -254,7 +254,7 @@ analysis that finds data races performs intra-procedural data flow analysis and can sometimes explode in time. Enable it at your own risk. </item> -i <tag><c><![CDATA[-Wunderspecs]]></c>***</tag> + <tag><c><![CDATA[-Wunderspecs]]></c>***</tag> <item>Warn about underspecified functions (the -spec is strictly more allowing than the success typing).</item> <tag><c><![CDATA[-Wunknown]]></c>***</tag> diff --git a/lib/dialyzer/src/Makefile b/lib/dialyzer/src/Makefile index 770af2140f..fd75cd5cd8 100644 --- a/lib/dialyzer/src/Makefile +++ b/lib/dialyzer/src/Makefile @@ -61,6 +61,7 @@ MODULES = \ dialyzer_gui_wx \ dialyzer_options \ dialyzer_plt \ + dialyzer_race_data_server \ dialyzer_races \ dialyzer_succ_typings \ dialyzer_timing \ @@ -140,6 +141,7 @@ $(EBIN)/dialyzer_explanation.beam: dialyzer.hrl $(EBIN)/dialyzer_gui_wx.beam: dialyzer.hrl dialyzer_gui_wx.hrl $(EBIN)/dialyzer_options.beam: dialyzer.hrl $(EBIN)/dialyzer_plt.beam: dialyzer.hrl +$(EBIN)/dialyzer_race_data_server.beam: dialyzer.hrl $(EBIN)/dialyzer_races.beam: dialyzer.hrl $(EBIN)/dialyzer_succ_typings.beam: dialyzer.hrl $(EBIN)/dialyzer_typesig.beam: dialyzer.hrl diff --git a/lib/dialyzer/src/dialyzer.app.src b/lib/dialyzer/src/dialyzer.app.src index 7794cb46c6..003d7f2ba4 100644 --- a/lib/dialyzer/src/dialyzer.app.src +++ b/lib/dialyzer/src/dialyzer.app.src @@ -37,6 +37,7 @@ dialyzer_gui_wx, dialyzer_options, dialyzer_plt, + dialyzer_race_data_server, dialyzer_races, dialyzer_succ_typings, dialyzer_typesig, diff --git a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl index 826ac51775..50fc1d8471 100644 --- a/lib/dialyzer/src/dialyzer_analysis_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_analysis_callgraph.erl @@ -2,7 +2,7 @@ %%-------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -31,14 +31,17 @@ -export([start/3]). +%%% Export for dialyzer_coordinator... -export([compile_init_result/0, - add_to_result/4, - start_compilation/2, + add_to_result/4]). +%%% ... and export for dialyzer_worker. +-export([start_compilation/2, continue_compilation/2]). -export_type([compile_init_data/0, - one_file_result/0, - compile_result/0]). + one_file_mid_error/0, + one_file_result_ok/0, + compile_result/0]). -include("dialyzer.hrl"). @@ -93,31 +96,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); @@ -165,8 +156,7 @@ analysis_start(Parent, Analysis, LegalWarnings) -> MergedExpTypes = sets:union(NewExpTypes, OldExpTypes1), TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer0), TmpCServer2 = - dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes, - TmpCServer1), + dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), ?timing(State#analysis_state.timing_server, "remote", begin TmpCServer3 = @@ -259,6 +249,10 @@ compile_and_store(Files, #analysis_state{codeserver = CServer, {T1, _} = statistics(wall_clock), Callgraph = dialyzer_callgraph:new(), CompileInit = make_compile_init(State, Callgraph), + %% Spawn a worker per file - where each worker calls + %% start_compilation on its file, asks next label to coordinator and + %% calls continue_compilation - and let coordinator aggregate + %% results using (compile_init_result and) add_to_result. {{Failed, Modules}, NextLabel} = ?timing(Timing, "compile", _C1, dialyzer_coordinator:parallel_job(compile, Files, @@ -290,16 +284,18 @@ compile_and_store(Files, #analysis_state{codeserver = CServer, send_log(Parent, Msg2), {Callgraph, CServer2}. --type compile_init_data() :: #compile_init{}. --type error_reason() :: string(). --type compile_result() :: {[{file:filename(), error_reason()}], - [module()]}. %%opaque --type one_file_result() :: {error, error_reason()} | - {ok, [dialyzer_callgraph:callgraph_edge()], - [mfa_or_funlbl()], module()}. %%opaque --type compile_mid_data() :: {module(), cerl:cerl(), - dialyzer_callgraph:callgraph(), - dialyzer_codeserver:codeserver()}. +-opaque compile_init_data() :: #compile_init{}. +-type error_reason() :: string(). +-opaque compile_result() :: {[{file:filename(), error_reason()}], + [module()]}. +-type one_file_mid_error() :: {error, error_reason()}. +-opaque one_file_result_ok() :: {ok, [dialyzer_callgraph:callgraph_edge()], + [mfa_or_funlbl()], module()}. +-type one_file_result() :: one_file_mid_error() | + one_file_result_ok(). +-type compile_mid_data() :: {module(), cerl:cerl(), + dialyzer_callgraph:callgraph(), + dialyzer_codeserver:codeserver()}. -spec compile_init_result() -> compile_result(). @@ -440,7 +436,8 @@ store_core(Mod, Core, Callgraph, CServer) -> CoreSize = cerl_trees:size(CoreTree), {ok, CoreSize, {Mod, CoreTree, Callgraph, CServer}}. --spec continue_compilation(integer(), compile_mid_data()) -> one_file_result(). +-spec continue_compilation(integer(), compile_mid_data()) -> + one_file_result_ok(). continue_compilation(NextLabel, {Mod, CoreTree, Callgraph, CServer}) -> {LabeledTree, _NewNextLabel} = cerl_trees:label(CoreTree, NextLabel), @@ -572,6 +569,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 +579,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. diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl index ede29b42bc..50abb22009 100644 --- a/lib/dialyzer/src/dialyzer_callgraph.erl +++ b/lib/dialyzer/src/dialyzer_callgraph.erl @@ -113,16 +113,11 @@ calls :: ets:tid() | 'undefined', % race race_detection = false :: boolean(), - race_data_server = new_race_data_server() :: pid()}). - --record(race_data_state, {race_code = dict:new() :: dict:dict(), - public_tables = [] :: [label()], - named_tables = [] :: [string()], - beh_api_calls = [] :: [{mfa(), mfa()}]}). + race_data_server = dialyzer_race_data_server:new() :: pid()}). %% Exported Types --type callgraph() :: #callgraph{}. +-opaque callgraph() :: #callgraph{}. -type active_digraph() :: {'d', digraph:graph()} | {'e', ets:tid(), ets:tid()}. @@ -616,45 +611,30 @@ digraph_reaching_subgraph(Funs, DG) -> renew_race_info(#callgraph{race_data_server = RaceDataServer} = CG, RaceCode, PublicTables, NamedTables) -> - ok = race_data_server_cast( + ok = dialyzer_race_data_server:cast( {renew_race_info, {RaceCode, PublicTables, NamedTables}}, RaceDataServer), CG. -renew_race_info({RaceCode, PublicTables, NamedTables}, - #race_data_state{} = State) -> - State#race_data_state{race_code = RaceCode, - public_tables = PublicTables, - named_tables = NamedTables}. - -spec renew_race_code(dialyzer_races:races(), callgraph()) -> callgraph(). renew_race_code(Races, #callgraph{race_data_server = RaceDataServer} = CG) -> Fun = dialyzer_races:get_curr_fun(Races), FunArgs = dialyzer_races:get_curr_fun_args(Races), Code = lists:reverse(dialyzer_races:get_race_list(Races)), - ok = race_data_server_cast( + ok = dialyzer_race_data_server:cast( {renew_race_code, {Fun, FunArgs, Code}}, RaceDataServer), CG. -renew_race_code_handler({Fun, FunArgs, Code}, - #race_data_state{race_code = RaceCode} = State) -> - State#race_data_state{race_code = dict:store(Fun, [FunArgs, Code], RaceCode)}. - -spec renew_race_public_tables(label(), callgraph()) -> callgraph(). renew_race_public_tables(VarLabel, #callgraph{race_data_server = RaceDataServer} = CG) -> ok = - race_data_server_cast({renew_race_public_tables, VarLabel}, RaceDataServer), + dialyzer_race_data_server:cast({renew_race_public_tables, VarLabel}, RaceDataServer), CG. -renew_race_public_tables_handler(VarLabel, - #race_data_state{public_tables = PT} - = State) -> - State#race_data_state{public_tables = ordsets:add_element(VarLabel, PT)}. - -spec cleanup(callgraph()) -> callgraph(). cleanup(#callgraph{digraph = Digraph, @@ -664,18 +644,18 @@ cleanup(#callgraph{digraph = Digraph, #callgraph{digraph = Digraph, name_map = NameMap, rev_name_map = RevNameMap, - race_data_server = race_data_server_call(dup, RaceDataServer)}. + race_data_server = dialyzer_race_data_server:duplicate(RaceDataServer)}. -spec duplicate(callgraph()) -> callgraph(). duplicate(#callgraph{race_data_server = RaceDataServer} = Callgraph) -> Callgraph#callgraph{ - race_data_server = race_data_server_call(dup, RaceDataServer)}. + race_data_server = dialyzer_race_data_server:duplicate(RaceDataServer)}. -spec dispose_race_server(callgraph()) -> ok. dispose_race_server(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_cast(stop, RaceDataServer). + dialyzer_race_data_server:stop(RaceDataServer). -spec get_digraph(callgraph()) -> digraph:graph(). @@ -685,17 +665,17 @@ get_digraph(#callgraph{digraph = Digraph}) -> -spec get_named_tables(callgraph()) -> [string()]. get_named_tables(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_call(get_named_tables, RaceDataServer). + dialyzer_race_data_server:call(get_named_tables, RaceDataServer). -spec get_public_tables(callgraph()) -> [label()]. get_public_tables(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_call(get_public_tables, RaceDataServer). + dialyzer_race_data_server:call(get_public_tables, RaceDataServer). -spec get_race_code(callgraph()) -> dict:dict(). get_race_code(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_call(get_race_code, RaceDataServer). + dialyzer_race_data_server:call(get_race_code, RaceDataServer). -spec get_race_detection(callgraph()) -> boolean(). @@ -705,12 +685,12 @@ get_race_detection(#callgraph{race_detection = RD}) -> -spec get_behaviour_api_calls(callgraph()) -> [{mfa(), mfa()}]. get_behaviour_api_calls(#callgraph{race_data_server = RaceDataServer}) -> - race_data_server_call(get_behaviour_api_calls, RaceDataServer). + dialyzer_race_data_server:call(get_behaviour_api_calls, RaceDataServer). -spec race_code_new(callgraph()) -> callgraph(). race_code_new(#callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast(race_code_new, RaceDataServer), + ok = dialyzer_race_data_server:cast(race_code_new, RaceDataServer), CG. -spec put_digraph(digraph:graph(), callgraph()) -> callgraph(). @@ -721,7 +701,7 @@ put_digraph(Digraph, Callgraph) -> -spec put_race_code(dict:dict(), callgraph()) -> callgraph(). put_race_code(RaceCode, #callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast({put_race_code, RaceCode}, RaceDataServer), + ok = dialyzer_race_data_server:cast({put_race_code, RaceCode}, RaceDataServer), CG. -spec put_race_detection(boolean(), callgraph()) -> callgraph(). @@ -733,78 +713,23 @@ put_race_detection(RaceDetection, Callgraph) -> put_named_tables(NamedTables, #callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast({put_named_tables, NamedTables}, RaceDataServer), + ok = dialyzer_race_data_server:cast({put_named_tables, NamedTables}, RaceDataServer), CG. -spec put_public_tables([label()], callgraph()) -> callgraph(). put_public_tables(PublicTables, #callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast({put_public_tables, PublicTables}, RaceDataServer), + ok = dialyzer_race_data_server:cast({put_public_tables, PublicTables}, RaceDataServer), CG. -spec put_behaviour_api_calls([{mfa(), mfa()}], callgraph()) -> callgraph(). put_behaviour_api_calls(Calls, #callgraph{race_data_server = RaceDataServer} = CG) -> - ok = race_data_server_cast({put_behaviour_api_calls, Calls}, RaceDataServer), + ok = dialyzer_race_data_server:cast({put_behaviour_api_calls, Calls}, RaceDataServer), CG. - -new_race_data_server() -> - spawn_link(fun() -> race_data_server_loop(#race_data_state{}) end). - -race_data_server_loop(State) -> - receive - {call, From, Ref, Query} -> - Reply = race_data_server_handle_call(Query, State), - From ! {Ref, Reply}, - race_data_server_loop(State); - {cast, stop} -> - ok; - {cast, Message} -> - NewState = race_data_server_handle_cast(Message, State), - race_data_server_loop(NewState) - end. - -race_data_server_call(Query, Server) -> - Ref = make_ref(), - Server ! {call, self(), Ref, Query}, - receive - {Ref, Reply} -> Reply - end. - -race_data_server_cast(Message, Server) -> - Server ! {cast, Message}, - ok. - -race_data_server_handle_cast(race_code_new, State) -> - State#race_data_state{race_code = dict:new()}; -race_data_server_handle_cast({Tag, Data}, State) -> - case Tag of - renew_race_info -> renew_race_info(Data, State); - renew_race_code -> renew_race_code_handler(Data, State); - renew_race_public_tables -> renew_race_public_tables_handler(Data, State); - put_race_code -> State#race_data_state{race_code = Data}; - put_public_tables -> State#race_data_state{public_tables = Data}; - put_named_tables -> State#race_data_state{named_tables = Data}; - put_behaviour_api_calls -> State#race_data_state{beh_api_calls = Data} - end. - -race_data_server_handle_call(Query, - #race_data_state{race_code = RaceCode, - public_tables = PublicTables, - named_tables = NamedTables, - beh_api_calls = BehApiCalls} - = State) -> - case Query of - dup -> spawn_link(fun() -> race_data_server_loop(State) end); - get_race_code -> RaceCode; - get_public_tables -> PublicTables; - get_named_tables -> NamedTables; - get_behaviour_api_calls -> BehApiCalls - end. - %%============================================================================= %% Utilities for 'dot' %%============================================================================= diff --git a/lib/dialyzer/src/dialyzer_cl.erl b/lib/dialyzer/src/dialyzer_cl.erl index 92134b7b81..50ff5304d6 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_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl index 83b3ef72f2..e03e4d5bb4 100644 --- a/lib/dialyzer/src/dialyzer_contracts.erl +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-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. @@ -167,8 +167,7 @@ process_contract_remote_types(CodeServer) -> dialyzer_codeserver:finalize_contracts(NewContractDict, NewCallbackDict, CodeServer). --type opaques() :: [erl_types:erl_type()] | 'universe'. --type opaques_fun() :: fun((module()) -> opaques()). +-type opaques_fun() :: fun((module()) -> [erl_types:erl_type()]). -type fun_types() :: dict:dict(label(), erl_types:type_table()). diff --git a/lib/dialyzer/src/dialyzer_coordinator.erl b/lib/dialyzer/src/dialyzer_coordinator.erl index 3290161ca1..87cbd25b30 100644 --- a/lib/dialyzer/src/dialyzer_coordinator.erl +++ b/lib/dialyzer/src/dialyzer_coordinator.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -29,8 +29,8 @@ %%% Export for dialyzer main process -export([parallel_job/4]). -%%% Exports for all possible workers --export([wait_activation/0, job_done/3]). +%%% Export for all possible workers +-export([job_done/3]). %%% Exports for the typesig and dataflow analysis workers -export([sccs_to_pids/2, request_activation/1]). @@ -46,7 +46,7 @@ -type regulator() :: pid(). -type scc_to_pid() :: ets:tid() | 'unused'. --type coordinator() :: {collector(), regulator(), scc_to_pid()}. %%opaque +-opaque coordinator() :: {collector(), regulator(), scc_to_pid()}. -type timing() :: dialyzer_timing:timing_server(). -type scc() :: [mfa_or_funlbl()]. @@ -75,8 +75,9 @@ -type result() :: compile_result() | typesig_result() | dataflow_result() | warnings_result(). --type job_result() :: dialyzer_analysis_callgraph:one_file_result() | - typesig_result() | dataflow_result() | warnings_result(). +-type job_result() :: dialyzer_analysis_callgraph:one_file_mid_error() | + dialyzer_analysis_callgraph:one_file_result_ok() | + typesig_result() | dataflow_result() | warnings_result(). -record(state, {mode :: mode(), active = 0 :: integer(), @@ -119,7 +120,7 @@ spawn_jobs(Mode, Jobs, InitData, Timing) -> Pid = dialyzer_worker:launch(Mode, Job, InitData, Coordinator), case TypesigOrDataflow of true -> true = ets:insert(SCCtoPID, {Job, Pid}), ok; - false -> request_activation(Regulator, Pid) + false -> ok end, Count + 1 end, @@ -218,10 +219,6 @@ request_activation({_Collector, Regulator, _SCCtoPID}) -> Regulator ! {req, self()}, wait_activation(). -request_activation(Regulator, Pid) -> - Regulator ! {req, Pid}, - ok. - spawn_regulator() -> InitTickets = dialyzer_utils:parallelism(), spawn_link(fun() -> regulator_loop(InitTickets, queue:new()) end). 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/src/dialyzer_race_data_server.erl b/lib/dialyzer/src/dialyzer_race_data_server.erl new file mode 100644 index 0000000000..3600491809 --- /dev/null +++ b/lib/dialyzer/src/dialyzer_race_data_server.erl @@ -0,0 +1,134 @@ +%% -*- erlang-indent-level: 2 -*- +%%----------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% 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% +%% + +%%%------------------------------------------------------------------- +%%% File : dialyzer_race_data_server.erl +%%% Author : Tobias Lindahl <[email protected]> +%%% Description : +%%% +%%% Created : 18 Sep 2015 by Luca Favatella <[email protected]> +%%%------------------------------------------------------------------- +-module(dialyzer_race_data_server). + +-export([new/0, + duplicate/1, + stop/1, + call/2, + cast/2]). + +-include("dialyzer.hrl"). + +%%---------------------------------------------------------------------- + +-record(state, {race_code = dict:new() :: dict:dict(), + public_tables = [] :: [label()], + named_tables = [] :: [string()], + beh_api_calls = [] :: [{mfa(), mfa()}]}). + +%%---------------------------------------------------------------------- + +-spec new() -> pid(). + +new() -> + spawn_link(fun() -> loop(#state{}) end). + +-spec duplicate(pid()) -> pid(). + +duplicate(Server) -> + call(dup, Server). + +-spec stop(pid()) -> ok. + +stop(Server) -> + cast(stop, Server). + +-spec call(atom(), pid()) -> term(). + +call(Query, Server) -> + Ref = make_ref(), + Server ! {call, self(), Ref, Query}, + receive + {Ref, Reply} -> Reply + end. + +-spec cast(atom() | {atom(), term()}, pid()) -> ok. + +cast(Message, Server) -> + Server ! {cast, Message}, + ok. + +%%---------------------------------------------------------------------- + +loop(State) -> + receive + {call, From, Ref, Query} -> + Reply = handle_call(Query, State), + From ! {Ref, Reply}, + loop(State); + {cast, stop} -> + ok; + {cast, Message} -> + NewState = handle_cast(Message, State), + loop(NewState) + end. + +handle_cast(race_code_new, State) -> + State#state{race_code = dict:new()}; +handle_cast({Tag, Data}, State) -> + case Tag of + renew_race_info -> renew_race_info_handler(Data, State); + renew_race_code -> renew_race_code_handler(Data, State); + renew_race_public_tables -> renew_race_public_tables_handler(Data, State); + put_race_code -> State#state{race_code = Data}; + put_public_tables -> State#state{public_tables = Data}; + put_named_tables -> State#state{named_tables = Data}; + put_behaviour_api_calls -> State#state{beh_api_calls = Data} + end. + +handle_call(Query, + #state{race_code = RaceCode, + public_tables = PublicTables, + named_tables = NamedTables, + beh_api_calls = BehApiCalls} + = State) -> + case Query of + dup -> spawn_link(fun() -> loop(State) end); + get_race_code -> RaceCode; + get_public_tables -> PublicTables; + get_named_tables -> NamedTables; + get_behaviour_api_calls -> BehApiCalls + end. + +%%---------------------------------------------------------------------- + +renew_race_info_handler({RaceCode, PublicTables, NamedTables}, + #state{} = State) -> + State#state{race_code = RaceCode, + public_tables = PublicTables, + named_tables = NamedTables}. + +renew_race_code_handler({Fun, FunArgs, Code}, + #state{race_code = RaceCode} = State) -> + State#state{race_code = dict:store(Fun, [FunArgs, Code], RaceCode)}. + +renew_race_public_tables_handler(VarLabel, + #state{public_tables = PT} = State) -> + State#state{public_tables = ordsets:add_element(VarLabel, PT)}. diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index 557e10eed7..5fc1c0e691 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -297,8 +297,8 @@ get_record_fields([], _RecDict, Acc) -> %% The field types are cached. Used during analysis when handling records. process_record_remote_types(CServer) -> TempRecords = dialyzer_codeserver:get_temp_records(CServer), - TempExpTypes = dialyzer_codeserver:get_temp_exported_types(CServer), - TempRecords1 = process_opaque_types0(TempRecords, TempExpTypes), + ExpTypes = dialyzer_codeserver:get_exported_types(CServer), + TempRecords1 = process_opaque_types0(TempRecords, ExpTypes), ModuleFun = fun(Module, Record) -> RecordFun = @@ -310,7 +310,7 @@ process_record_remote_types(CServer) -> Site = {record, {Module, Name, Arity}}, [{FieldName, Field, erl_types:t_from_form(Field, - TempExpTypes, + ExpTypes, Site, TempRecords1)} || {FieldName, Field, _} <- Fields] @@ -323,9 +323,8 @@ process_record_remote_types(CServer) -> dict:map(RecordFun, Record) end, NewRecords = dict:map(ModuleFun, TempRecords1), - ok = check_record_fields(NewRecords, TempExpTypes), - CServer1 = dialyzer_codeserver:finalize_records(NewRecords, CServer), - dialyzer_codeserver:finalize_exported_types(TempExpTypes, CServer1). + ok = check_record_fields(NewRecords, ExpTypes), + dialyzer_codeserver:finalize_records(NewRecords, CServer). %% erl_types:t_from_form() substitutes the declaration of opaque types %% for the expanded type in some cases. To make sure the initial type, diff --git a/lib/dialyzer/src/dialyzer_worker.erl b/lib/dialyzer/src/dialyzer_worker.erl index 979e3a621d..b9ab27c11d 100644 --- a/lib/dialyzer/src/dialyzer_worker.erl +++ b/lib/dialyzer/src/dialyzer_worker.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2012. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -21,16 +21,15 @@ -module(dialyzer_worker). --export([launch/4, sequential/4]). +-export([launch/4]). -export_type([worker/0]). --type worker() :: pid(). %%opaque +-opaque worker() :: pid(). -type mode() :: dialyzer_coordinator:mode(). -type coordinator() :: dialyzer_coordinator:coordinator(). -type init_data() :: dialyzer_coordinator:init_data(). --type result() :: dialyzer_coordinator:result(). -type job() :: dialyzer_coordinator:job(). -record(state, { @@ -60,16 +59,21 @@ launch(Mode, Job, InitData, Coordinator) -> job = Job, init_data = InitData, coordinator = Coordinator}, - InitState = - case Mode of - X when X =:= 'typesig'; X =:= 'dataflow' -> initializing; - X when X =:= 'compile'; X =:= 'warnings' -> running - end, - spawn_link(fun() -> loop(InitState, State) end). + spawn_link(fun() -> init(State) end). %%-------------------------------------------------------------------- -loop(updating, State) -> +init(#state{job = SCC, mode = Mode, init_data = InitData} = State) when + Mode =:= 'typesig'; Mode =:= 'dataflow' -> + DependsOn = dialyzer_succ_typings:find_depends_on(SCC, InitData), + ?debug("Deps ~p: ~p\n",[SCC, DependsOn]), + loop(updating, State#state{depends_on = DependsOn}); +init(#state{mode = Mode} = State) when + Mode =:= 'compile'; Mode =:= 'warnings' -> + loop(running, State). + +loop(updating, #state{mode = Mode} = State) when + Mode =:= 'typesig'; Mode =:= 'dataflow' -> ?debug("Update: ~p\n",[State#state.job]), NextStatus = case waits_more_success_typings(State) of @@ -77,16 +81,13 @@ loop(updating, State) -> false -> running end, loop(NextStatus, State); -loop(initializing, #state{job = SCC, init_data = InitData} = State) -> - DependsOn = dialyzer_succ_typings:find_depends_on(SCC, InitData), - ?debug("Deps ~p: ~p\n",[State#state.job, DependsOn]), - loop(updating, State#state{depends_on = DependsOn}); -loop(waiting, State) -> +loop(waiting, #state{mode = Mode} = State) when + Mode =:= 'typesig'; Mode =:= 'dataflow' -> ?debug("Wait: ~p\n",[State#state.job]), NewState = wait_for_success_typings(State), loop(updating, NewState); loop(running, #state{mode = 'compile'} = State) -> - dialyzer_coordinator:wait_activation(), + dialyzer_coordinator:request_activation(State#state.coordinator), ?debug("Compile: ~s\n",[State#state.job]), Result = case start_compilation(State) of @@ -98,7 +99,7 @@ loop(running, #state{mode = 'compile'} = State) -> end, report_to_coordinator(Result, State); loop(running, #state{mode = 'warnings'} = State) -> - dialyzer_coordinator:wait_activation(), + dialyzer_coordinator:request_activation(State#state.coordinator), ?debug("Warning: ~s\n",[State#state.job]), Result = collect_warnings(State), report_to_coordinator(Result, State); @@ -170,22 +171,3 @@ continue_compilation(Label, Data) -> collect_warnings(#state{job = Job, init_data = InitData}) -> dialyzer_succ_typings:collect_warnings(Job, InitData). - -%%------------------------------------------------------------------------------ - --type extra() :: label() | 'unused'. - --spec sequential(mode(), job(), init_data(), extra()) -> result(). - -sequential('compile', Job, InitData, Extra) -> - case dialyzer_analysis_callgraph:start_compilation(Job, InitData) of - {ok, EstimatedSize, Data} -> - {EstimatedSize, continue_compilation(Extra, Data)}; - {error, _Reason} = Error -> {0, Error} - end; -sequential('typesig', Job, InitData, _Extra) -> - dialyzer_succ_typings:find_succ_types_for_scc(Job, InitData); -sequential('dataflow', Job, InitData, _Extra) -> - dialyzer_succ_typings:refine_one_module(Job, InitData); -sequential('warnings', Job, InitData, _Extra) -> - dialyzer_succ_typings:collect_warnings(Job, InitData). diff --git a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return index 4103a2d8b4..89eb295604 100644 --- a/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return +++ b/lib/dialyzer/test/behaviour_SUITE_data/results/supervisor_incorrect_return @@ -1,2 +1,2 @@ -supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{},[{_,{atom() | tuple(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom() | tuple()]} | #{}]}}, which is the expected return type for the callback of supervisor behaviour +supervisor_incorrect_return.erl:14: The inferred return type of init/1 ({'ok',{{'one_against_one',0,1},[{_,_,_,_,_,_},...]}}) has nothing in common with 'ignore' | {'ok',{{'one_for_all',non_neg_integer(),pos_integer()} | {'one_for_one',non_neg_integer(),pos_integer()} | {'rest_for_one',non_neg_integer(),pos_integer()} | {'simple_one_for_one',non_neg_integer(),pos_integer()} | #{},[{_,{atom(),atom(),'undefined' | [any()]},'permanent' | 'temporary' | 'transient','brutal_kill' | 'infinity' | non_neg_integer(),'supervisor' | 'worker','dynamic' | [atom()]} | #{}]}}, which is the expected return type for the callback of supervisor behaviour diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/simple b/lib/dialyzer/test/opaque_SUITE_data/results/simple index 5f58f69730..391c37664e 100644 --- a/lib/dialyzer/test/opaque_SUITE_data/results/simple +++ b/lib/dialyzer/test/opaque_SUITE_data/results/simple @@ -70,8 +70,8 @@ simple1_api.erl:478: The call 'foo':A(A::simple1_adt:a()) breaks the opaqueness simple1_api.erl:486: The call A:'foo'(A::simple1_adt:a()) breaks the opaqueness of the term A :: simple1_adt:a() simple1_api.erl:499: The call 'foo':A(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i() simple1_api.erl:503: The call 'foo':A(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i() -simple1_api.erl:507: The call A:'foo'(A::simple1_api:i()) requires that A is of type atom() | tuple() not simple1_api:i() -simple1_api.erl:511: The call A:'foo'(A::simple1_adt:i()) requires that A is of type atom() | tuple() not simple1_adt:i() +simple1_api.erl:507: The call A:'foo'(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i() +simple1_api.erl:511: The call A:'foo'(A::simple1_adt:i()) requires that A is of type atom() not simple1_adt:i() simple1_api.erl:519: Guard test A::simple1_adt:d2() == B::simple1_adt:d1() contains opaque terms as 1st and 2nd arguments simple1_api.erl:534: Guard test A::simple1_adt:d1() >= 3 contains an opaque term as 1st argument simple1_api.erl:536: Guard test A::simple1_adt:d1() == 3 contains an opaque term as 1st argument diff --git a/lib/dialyzer/test/plt_SUITE.erl b/lib/dialyzer/test/plt_SUITE.erl index ecbac14e5d..16180a7435 100644 --- a/lib/dialyzer/test/plt_SUITE.erl +++ b/lib/dialyzer/test/plt_SUITE.erl @@ -7,12 +7,15 @@ -include("dialyzer_test_constants.hrl"). -export([suite/0, all/0, build_plt/1, beam_tests/1, update_plt/1, + local_fun_same_as_callback/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, run_succ_typings, + local_fun_same_as_callback]. build_plt(Config) -> OutDir = ?config(priv_dir, Config), @@ -158,6 +161,59 @@ 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. + + compile(Config, Prog, Module, CompileOpts) -> Source = lists:concat([Module, ".erl"]), PrivDir = ?config(priv_dir,Config), diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia index 220b18ca7a..bf67447ee7 100644 --- a/lib/dialyzer/test/r9c_SUITE_data/results/mnesia +++ b/lib/dialyzer/test/r9c_SUITE_data/results/mnesia @@ -35,6 +35,6 @@ mnesia_schema.erl:1258: Guard test FromS::'disc_copies' | 'disc_only_copies' | ' mnesia_schema.erl:1639: The pattern {'false', 'mandatory'} can never match the type {'false','optional'} mnesia_schema.erl:2434: The variable Reason can never match since previous clauses completely covered the type {'error',_} | {'ok',_} mnesia_schema.erl:451: Guard test UseDirAnyway::'false' == 'true' can never succeed -mnesia_text.erl:180: The variable T can never match since previous clauses completely covered the type {'error',{non_neg_integer(),atom() | tuple(),_}} | {'ok',_} +mnesia_text.erl:180: The variable T can never match since previous clauses completely covered the type {'error',{non_neg_integer(),atom(),_}} | {'ok',_} mnesia_tm.erl:1522: Function commit_participant/5 has no local return mnesia_tm.erl:2169: Function system_terminate/4 has no local return diff --git a/lib/dialyzer/test/small_SUITE_data/results/app_call b/lib/dialyzer/test/small_SUITE_data/results/app_call index cc1a63f944..1af649815a 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/app_call +++ b/lib/dialyzer/test/small_SUITE_data/results/app_call @@ -1,3 +1,3 @@ -app_call.erl:6: The call M:'foo'() requires that M is of type atom() | tuple() not 42 +app_call.erl:6: The call M:'foo'() requires that M is of type atom() not 42 app_call.erl:9: The call 'mod':F() requires that F is of type atom() not {'gazonk',[]} diff --git a/lib/dialyzer/test/small_SUITE_data/results/maps1 b/lib/dialyzer/test/small_SUITE_data/results/maps1 index 5a78d66a92..e88c91f21f 100644 --- a/lib/dialyzer/test/small_SUITE_data/results/maps1 +++ b/lib/dialyzer/test/small_SUITE_data/results/maps1 @@ -1,4 +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 #{} +maps1.erl:52: The call Mod:'function'(~{'literal'=>'map'}~,'another_arg') requires that Mod is of type atom() not #{} 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/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/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_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 622c235638..e36643e090 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -137,7 +137,7 @@ type(M, F, A) -> type(M, F, A, Xs) -> type(M, F, A, Xs, 'universe'). --type opaques() :: 'universe' | [erl_types:erl_type()]. +-type opaques() :: erl_types:opaques(). -type arg_types() :: [erl_types:erl_type()]. diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 69654088d5..fae12d7421 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -172,7 +172,6 @@ t_number_vals/1, t_number_vals/2, t_opaque_from_records/1, t_opaque_structure/1, - %% t_parameterized_module/0, t_pid/0, t_port/0, t_maybe_improper_list/0, @@ -225,7 +224,7 @@ -export([t_is_identifier/1]). -endif. --export_type([erl_type/0, type_table/0, var_table/0]). +-export_type([erl_type/0, opaques/0, type_table/0, var_table/0]). %%-define(DEBUG, true). @@ -1785,7 +1784,7 @@ t_mfa() -> -spec t_module() -> erl_type(). t_module() -> - t_sup(t_atom(), t_parameterized_module()). + t_atom(). -spec t_node() -> erl_type(). @@ -1811,11 +1810,6 @@ t_iolist(N, T) when N > 0 -> t_iolist(0, T) -> t_maybe_improper_list(t_any(), t_sup(T, t_nil())). --spec t_parameterized_module() -> erl_type(). - -t_parameterized_module() -> - t_tuple(). - -spec t_timeout() -> erl_type(). t_timeout() -> @@ -2425,8 +2419,7 @@ t_inf(T1, T2) -> t_inf(T1, T2, 'universe'). %% 'match' should be used from t_find_unknown_opaque() only --type t_inf_opaques() :: 'universe' - | [erl_type()] | {'match', [erl_type() | 'universe']}. +-type t_inf_opaques() :: opaques() | {'match', [erl_type() | 'universe']}. -spec t_inf(erl_type(), erl_type(), t_inf_opaques()) -> erl_type(). @@ -3604,7 +3597,7 @@ t_is_instance(ConcreteType, Type) -> t_unopaque(T) -> t_unopaque(T, 'universe'). --spec t_unopaque(erl_type(), 'universe' | [erl_type()]) -> erl_type(). +-spec t_unopaque(erl_type(), opaques()) -> erl_type(). t_unopaque(?opaque(_) = T, Opaques) -> case Opaques =:= 'universe' orelse is_opaque_type(T, Opaques) of 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 282a97e720..79203fd1a4 100644 --- a/lib/inets/src/tftp/tftp_engine.erl +++ b/lib/inets/src/tftp/tftp_engine.erl @@ -1154,8 +1154,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 acc39145e2..d4c9a48901 100644 --- a/lib/kernel/doc/src/code.xml +++ b/lib/kernel/doc/src/code.xml @@ -263,6 +263,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"/> @@ -387,12 +427,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> @@ -404,7 +440,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 @@ -420,7 +456,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> @@ -437,12 +474,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/os.xml b/lib/kernel/doc/src/os.xml index 682d4a2eac..165160a909 100644 --- a/lib/kernel/doc/src/os.xml +++ b/lib/kernel/doc/src/os.xml @@ -37,6 +37,7 @@ use these functions can be of help in enabling a program to run on most platforms.</p> </description> + <funcs> <func> <name name="cmd" arity="1"/> @@ -210,6 +211,30 @@ format_utc_timestamp() -> </desc> </func> <func> + <name name="perf_counter" arity="0"/> + <fsummary>Returns a performance counter</fsummary> + <desc> + <p>Returns the current performance counter value in <c>perf_counter</c> + <seealso marker="erts:erlang#type_time_unit">time unit</seealso>. + This is a highly optimized call that might not be traceable. + </p> + </desc> + </func> + <func> + <name name="perf_counter" arity="1"/> + <fsummary>Returns a performance counter</fsummary> + <desc><p>Returns a performance counter that can be used as a very fast and + high resolution timestamp. This counter is read directly from the hardware or operating + system with the same guarantees. This means that two consecutive calls + to the function are not guaranteed to be monotonic, though it most likely will be. + The performance counter till be converted to the resolution passed as an argument.</p> + <pre>1> <input>T1 = os:perf_counter(1000),receive after 10000 -> ok end,T2 = os:perf_counter(1000).</input> +176525861 +2> <input>T2 - T1.</input> +10004</pre> + </desc> + </func> + <func> <name name="type" arity="0"/> <fsummary>Return the OS family and, in some cases, OS name of the current operating system</fsummary> <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 ae28c97b47..59e226df43 100644 --- a/lib/kernel/src/code.erl +++ b/lib/kernel/src/code.erl @@ -60,7 +60,7 @@ del_path/1, replace_path/2, rehash/0, - start_link/0, start_link/1, + start_link/0, which/1, where_is_file/1, where_is_file/2, @@ -79,10 +79,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()}. @@ -137,14 +136,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(). @@ -305,15 +306,11 @@ get_mode() -> call(get_mode). %%----------------------------------------------------------------- call(Req) -> - code_server:call(code_server, Req). + code_server:call(Req). -spec start_link() -> {'ok', pid()} | {'error', 'crash'}. start_link() -> - start_link([stick]). - --spec start_link(Flags :: [atom()]) -> {'ok', pid()} | {'error', 'crash'}. -start_link(Flags) -> - do_start(Flags). + do_start(). %%----------------------------------------------------------------- %% In the init phase, code must not use any modules not yet loaded, @@ -325,36 +322,21 @@ start_link(Flags) -> %% us, so the module is loaded. %%----------------------------------------------------------------- -do_start(Flags) -> +do_start() -> maybe_warn_for_cache(), load_code_server_prerequisites(), - Mode = get_mode(Flags), - case init:get_argument(root) of - {ok,[[Root0]]} -> - Root = filename:join([Root0]), % Normalize. Use filename - case code_server:start_link([Root,Mode]) of - {ok,_Pid} = Ok2 -> - if - Mode =:= interactive -> - case lists:member(stick, Flags) of - true -> do_stick_dirs(); - _ -> ok - end; - true -> - ok - end, - %% Quietly load native code for all modules loaded so far - Architecture = erlang:system_info(hipe_architecture), - load_native_code_for_all_loaded(Architecture), - Ok2; - Other -> - Other - end; - Other -> - error_logger:error_msg("Can not start code server ~w ~n", [Other]), - {error, crash} - end. + {ok,[[Root0]]} = init:get_argument(root), + Mode = start_get_mode(), + Root = filename:join([Root0]), % Normalize. + Res = code_server:start_link([Root,Mode]), + + maybe_stick_dirs(Mode), + + %% Quietly load native code for all modules loaded so far. + Architecture = erlang:system_info(hipe_architecture), + load_native_code_for_all_loaded(Architecture), + Res. %% Make sure that all modules that the code_server process calls %% (directly or indirectly) are loaded. Otherwise the code_server @@ -374,6 +356,16 @@ load_code_server_prerequisites() -> _ = [M = M:module_info(module) || M <- Needed], ok. +maybe_stick_dirs(interactive) -> + case init:get_argument(nostick) of + {ok,[[]]} -> + ok; + _ -> + do_stick_dirs() + end; +maybe_stick_dirs(_) -> + ok. + do_stick_dirs() -> do_s(compiler), do_s(stdlib), @@ -391,19 +383,12 @@ do_s(Lib) -> ok end. -get_mode(Flags) -> - case lists:member(embedded, Flags) of - true -> +start_get_mode() -> + case init:get_argument(mode) of + {ok,[["embedded"]]} -> embedded; - _Otherwise -> - case init:get_argument(mode) of - {ok,[["embedded"]]} -> - embedded; - {ok,[["minimal"]]} -> - minimal; - _Else -> - interactive - end + _ -> + interactive end. %% Find out which version of a particular module we would diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl index 1a42cc0e9f..b52def8777 100644 --- a/lib/kernel/src/code_server.erl +++ b/lib/kernel/src/code_server.erl @@ -22,9 +22,7 @@ %% This file holds the server part of the code_server. -export([start_link/1, - call/2, - system_continue/3, - system_terminate/4, + call/1, system_code_change/4, error_msg/2, info_msg/2 ]). @@ -35,15 +33,18 @@ -define(ANY_NATIVE_CODE_LOADED, any_native_code_loaded). --record(state, {supervisor, - root, - path, - moddb, - namedb, - mode = interactive, - on_load = []}). +-type on_load_item() :: {reference(),module(),file:name_all(),[pid()]}. + +-record(state, {supervisor :: pid(), + root :: file:name_all(), + path :: [file:name_all()], + moddb :: ets:tab(), + namedb :: ets:tab(), + mode = interactive :: 'interactive' | 'embedded', + on_load = [] :: [on_load_item()]}). -type state() :: #state{}. +-spec start_link([term()]) -> {'ok', pid()}. start_link(Args) -> Ref = make_ref(), Parent = self(), @@ -58,7 +59,7 @@ start_link(Args) -> %% Init the code_server process. %% ----------------------------------------------------------- -init(Ref, Parent, [Root,Mode0]) -> +init(Ref, Parent, [Root,Mode]) -> register(?MODULE, self()), process_flag(trap_exit, true), @@ -69,12 +70,6 @@ init(Ref, Parent, [Root,Mode0]) -> end, erlang:pre_loaded()), ets:insert(Db, init:fetch_loaded()), - Mode = - case Mode0 of - minimal -> interactive; - _ -> Mode0 - end, - IPath = case Mode of interactive -> @@ -88,7 +83,8 @@ init(Ref, Parent, [Root,Mode0]) -> end, Path = add_loader_path(IPath, Mode), - State = #state{root = Root, + State = #state{supervisor = Parent, + root = Root, path = Path, moddb = Db, namedb = init_namedb(Path), @@ -97,7 +93,7 @@ init(Ref, Parent, [Root,Mode0]) -> put(?ANY_NATIVE_CODE_LOADED, false), Parent ! {Ref,{ok,self()}}, - loop(State#state{supervisor = Parent}). + loop(State). get_user_lib_dirs() -> case os:getenv("ERL_LIBS") of @@ -133,8 +129,9 @@ split_paths([C|T], S, Path, Paths) -> split_paths([], _S, Path, Paths) -> lists:reverse(Paths, [lists:reverse(Path)]). -call(Name, Req) -> - Name ! {code_call, self(), Req}, +-spec call(term()) -> term(). +call(Req) -> + ?MODULE ! {code_call, self(), Req}, receive {?MODULE, Reply} -> Reply @@ -246,13 +243,8 @@ handle_call({dir,Dir}, {_From,_Tag}, S) -> Resp = do_dir(Root,Dir,S#state.namedb), {reply,Resp,S}; -handle_call({load_file,Mod}, Caller, St) -> - case modp(Mod) of - false -> - {reply,{error,badarg},St}; - true -> - load_file(Mod, Caller, St) - end; +handle_call({load_file,Mod}, Caller, St) when is_atom(Mod) -> + load_file(Mod, Caller, St); handle_call({add_path,Where,Dir0}, {_From,_Tag}, #state{namedb=Namedb,path=Path0}=S) -> @@ -283,7 +275,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}; @@ -291,7 +283,7 @@ handle_call({load_abs,File,Mod}, Caller, S) -> load_abs(File, Mod, Caller, S) end; -handle_call({load_binary,Mod,File,Bin}, Caller, S) -> +handle_call({load_binary,Mod,File,Bin}, Caller, S) when is_atom(Mod) -> do_load_binary(Mod, File, Bin, Caller, S); handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) -> @@ -307,59 +299,44 @@ handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) -> Status = hipe_result_to_status(Result), {reply,Status,S}; -handle_call({ensure_loaded,Mod0}, Caller, St0) -> - Fun = fun (M, St) -> - case erlang:module_loaded(M) of - true -> - {reply,{module,M},St}; - false when St#state.mode =:= interactive -> - load_file(M, Caller, St); - false -> - {reply,{error,embedded},St} - end - end, - do_mod_call(Fun, Mod0, {error,badarg}, St0); - -handle_call({delete,Mod0}, {_From,_Tag}, S) -> - Fun = fun (M, St) -> - case catch erlang:delete_module(M) of - true -> - ets:delete(St#state.moddb, M), - {reply,true,St}; - _ -> - {reply,false,St} - end - end, - do_mod_call(Fun, Mod0, false, S); +handle_call({ensure_loaded,Mod}, Caller, St) when is_atom(Mod) -> + case erlang:module_loaded(Mod) of + true -> + {reply,{module,Mod},St}; + false when St#state.mode =:= interactive -> + load_file(Mod, Caller, St); + false -> + {reply,{error,embedded},St} + end; + +handle_call({delete,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + case catch erlang:delete_module(Mod) of + true -> + ets:delete(St#state.moddb, Mod), + {reply,true,St}; + _ -> + {reply,false,St} + end; -handle_call({purge,Mod0}, {_From,_Tag}, St0) -> - do_mod_call(fun (M, St) -> - {reply,do_purge(M),St} - end, Mod0, false, St0); +handle_call({purge,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + {reply,do_purge(Mod),St}; -handle_call({soft_purge,Mod0}, {_From,_Tag}, St0) -> - do_mod_call(fun (M, St) -> - {reply,do_soft_purge(M),St} - end, Mod0, true, St0); +handle_call({soft_purge,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + {reply,do_soft_purge(Mod),St}; -handle_call({is_loaded,Mod0}, {_From,_Tag}, St0) -> - do_mod_call(fun (M, St) -> - {reply,is_loaded(M, St#state.moddb),St} - end, Mod0, false, St0); +handle_call({is_loaded,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + {reply,is_loaded(Mod, St#state.moddb),St}; handle_call(all_loaded, {_From,_Tag}, S) -> Db = S#state.moddb, {reply,all_loaded(Db),S}; -handle_call({get_object_code,Mod0}, {_From,_Tag}, St0) -> - Fun = fun(M, St) -> - Path = St#state.path, - case mod_to_bin(Path, atom_to_list(M)) of - {_,Bin,FName} -> {reply,{M,Bin,FName},St}; - Error -> {reply,Error,St} - end - end, - do_mod_call(Fun, Mod0, error, St0); +handle_call({get_object_code,Mod}, {_From,_Tag}, St) when is_atom(Mod) -> + Path = St#state.path, + case mod_to_bin(Path, Mod) of + {_,Bin,FName} -> {reply,{Mod,Bin,FName},St}; + Error -> {reply,Error,St} + end; handle_call({is_sticky, Mod}, {_From,_Tag}, S) -> Db = S#state.moddb, @@ -383,17 +360,6 @@ handle_call(Other,{_From,_Tag}, S) -> error_msg(" ** Codeserver*** ignoring ~w~n ",[Other]), {noreply,S}. -do_mod_call(Action, Module, _Error, St) when is_atom(Module) -> - Action(Module, St); -do_mod_call(Action, Module, Error, St) -> - try list_to_atom(Module) of - Atom when is_atom(Atom) -> - Action(Atom, St) - catch - error:badarg -> - {reply,Error,St} - end. - %% -------------------------------------------------------------- %% Path handling functions. %% -------------------------------------------------------------- @@ -1091,9 +1057,9 @@ add_paths(_,_,Path,_) -> {ok,Path}. do_load_binary(Module, File, Binary, Caller, St) -> - case modp(Module) andalso modp(File) andalso is_binary(Binary) of + case modp(File) andalso is_binary(Binary) of true -> - case erlang:module_loaded(to_atom(Module)) of + case erlang:module_loaded(Module) of true -> do_purge(Module); false -> ok end, @@ -1106,15 +1072,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); @@ -1123,10 +1084,9 @@ load_abs(File, Mod0, Caller, St) -> end. try_load_module(File, Mod, Bin, {From,_}=Caller, St0) -> - M = to_atom(Mod), - case pending_on_load(M, From, St0) of + case pending_on_load(Mod, From, St0) of no -> - try_load_module_1(File, M, Bin, Caller, St0); + try_load_module_1(File, Mod, Bin, Caller, St0); {yes,St} -> {noreply,St} end. @@ -1145,9 +1105,10 @@ try_load_module_2(File, Mod, Bin, Caller, undefined, St) -> try_load_module_3(File, Mod, Bin, Caller, undefined, St); try_load_module_2(File, Mod, Bin, Caller, Architecture, #state{moddb=Db}=St) -> - case catch load_native_code(Mod, Bin, Architecture) of + case catch hipe_unified_loader:load_native_code(Mod, Bin, Architecture) of {module,Mod} = Module -> - ets:insert(Db, {Mod,File}), + put(?ANY_NATIVE_CODE_LOADED, true), + ets:insert(Db, {Mod,File}), {reply,Module,St}; no_native -> try_load_module_3(File, Mod, Bin, Caller, Architecture, St); @@ -1170,26 +1131,6 @@ try_load_module_3(File, Mod, Bin, Caller, Architecture, {reply,Error,St} end. -load_native_code(Mod, Bin, Architecture) -> - %% During bootstrapping of Open Source Erlang, we don't have any hipe - %% loader modules, but the Erlang emulator might be hipe enabled. - %% Therefore we must test for that the loader modules are available - %% before trying to to load native code. - case erlang:module_loaded(hipe_unified_loader) of - false -> - no_native; - true -> - Result = hipe_unified_loader:load_native_code(Mod, Bin, - Architecture), - case Result of - {module,_} -> - put(?ANY_NATIVE_CODE_LOADED, true); - _ -> - ok - end, - Result - end. - hipe_result_to_status(Result) -> case Result of {module,_} -> @@ -1212,8 +1153,7 @@ int_list([H|T]) when is_integer(H) -> int_list(T); int_list([_|_]) -> false; int_list([]) -> true. -load_file(Mod0, {From,_}=Caller, St0) -> - Mod = to_atom(Mod0), +load_file(Mod, {From,_}=Caller, St0) -> case pending_on_load(Mod, From, St0) of no -> load_file_1(Mod, Caller, St0); {yes,St} -> {noreply,St} @@ -1224,11 +1164,11 @@ load_file_1(Mod, Caller, #state{path=Path}=St) -> error -> {reply,{error,nofile},St}; {Mod,Binary,File} -> - try_load_module(File, Mod, Binary, Caller, St) + try_load_module_1(File, Mod, Binary, Caller, St) end. mod_to_bin([Dir|Tail], Mod) -> - File = filename:append(Dir, to_list(Mod) ++ objfile_extension()), + File = filename:append(Dir, atom_to_list(Mod) ++ objfile_extension()), case erl_prim_loader:get_file(File) of error -> mod_to_bin(Tail, Mod); @@ -1288,13 +1228,11 @@ is_loaded(M, Db) -> [] -> false end. -do_purge(Mod0) -> - Mod = to_atom(Mod0), +do_purge(Mod) -> {_WasOld, DidKill} = erts_code_purger:purge(Mod), DidKill. -do_soft_purge(Mod0) -> - Mod = to_atom(Mod0), +do_soft_purge(Mod) -> erts_code_purger:soft_purge(Mod). @@ -1392,13 +1330,13 @@ strip_mod_info([{{sticky,_},_}|T], Acc) -> strip_mod_info(T, Acc); strip_mod_info([H|T], Acc) -> strip_mod_info(T, [H|Acc]); strip_mod_info([], Acc) -> Acc. -% error_msg(Format) -> -% error_msg(Format,[]). +-spec error_msg(io:format(), [term()]) -> 'ok'. error_msg(Format, Args) -> Msg = {notify,{error, group_leader(), {self(), Format, Args}}}, error_logger ! Msg, ok. +-spec info_msg(io:format(), [term()]) -> 'ok'. info_msg(Format, Args) -> Msg = {notify,{info_msg, group_leader(), {self(), Format, Args}}}, error_logger ! Msg, @@ -1412,6 +1350,3 @@ archive_extension() -> to_list(X) when is_list(X) -> X; to_list(X) when is_atom(X) -> atom_to_list(X). - -to_atom(X) when is_atom(X) -> X; -to_atom(X) when is_list(X) -> list_to_atom(X). 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/kernel.erl b/lib/kernel/src/kernel.erl index 5f33f25a0d..40544da6c3 100644 --- a/lib/kernel/src/kernel.erl +++ b/lib/kernel/src/kernel.erl @@ -98,7 +98,7 @@ init([]) -> {kernel_config, start_link, []}, permanent, 2000, worker, [kernel_config]}, Code = {code_server, - {code, start_link, get_code_args()}, + {code, start_link, []}, permanent, 2000, worker, [code]}, File = {file_server_2, {file_server, start_link, []}, @@ -158,12 +158,6 @@ init(safe) -> {ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}. -get_code_args() -> - case init:get_argument(nostick) of - {ok, [[]]} -> [[nostick]]; - _ -> [] - end. - start_dist_ac() -> Spec = [{dist_ac,{dist_ac,start_link,[]},permanent,2000,worker,[dist_ac]}], case application:get_env(kernel, start_dist_ac) of diff --git a/lib/kernel/src/os.erl b/lib/kernel/src/os.erl index 0022959c11..4947088635 100644 --- a/lib/kernel/src/os.erl +++ b/lib/kernel/src/os.erl @@ -27,7 +27,9 @@ %%% BIFs --export([getenv/0, getenv/1, getenv/2, getpid/0, putenv/2, system_time/0, system_time/1, +-export([getenv/0, getenv/1, getenv/2, getpid/0, + perf_counter/0, perf_counter/1, + putenv/2, system_time/0, system_time/1, timestamp/0, unsetenv/1]). -spec getenv() -> [string()]. @@ -60,6 +62,18 @@ getenv(VarName, DefaultValue) -> getpid() -> erlang:nif_error(undef). +-spec perf_counter() -> Counter when + Counter :: integer(). + +perf_counter() -> + erlang:nif_error(undef). + +-spec perf_counter(Unit) -> integer() when + Unit :: erlang:time_unit(). + +perf_counter(Unit) -> + erlang:convert_time_unit(os:perf_counter(), perf_counter, Unit). + -spec putenv(VarName, Value) -> true when VarName :: string(), Value :: string(). 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 772a1e6b14..2a8468942c 100644 --- a/lib/kernel/test/code_SUITE.erl +++ b/lib/kernel/test/code_SUITE.erl @@ -321,6 +321,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"), @@ -850,18 +851,7 @@ check_funs({'$M_EXPR','$F_EXPR',1}, {code_server,start_link,1}]) -> 0; check_funs({'$M_EXPR','$F_EXPR',1}, [{lists,filter,2}, - {code_server,try_archive_subdirs,3}, - {code_server,all_archive_subdirs,1}, - {code_server,archive_subdirs,1}, - {code_server,insert_name,3}, - {code_server,replace_name,2}, - {code_server,update,2}, - {code_server,maybe_update,2}, - {code_server,do_add,4}, - {code_server,add_path,4}, - {code_server,handle_call,3}, - {code_server,loop,1}, - {code_server,system_continue,3}]) -> 0; + {code_server,try_archive_subdirs,3}|_]) -> 0; check_funs({'$M_EXPR','$F_EXPR',_}, [{erlang,apply,2}, {erlang,spawn_link,1}, @@ -1449,6 +1439,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/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl index 83a95019e7..e6e8568394 100644 --- a/lib/kernel/test/os_SUITE.erl +++ b/lib/kernel/test/os_SUITE.erl @@ -20,10 +20,11 @@ -module(os_SUITE). -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2]). + init_per_group/2,end_per_group/2, + init_per_testcase/2,end_per_testcase/2]). -export([space_in_cwd/1, quoting/1, cmd_unicode/1, space_in_name/1, bad_command/1, find_executable/1, unix_comment_in_command/1, deep_list_command/1, - large_output_command/1]). + large_output_command/1, perf_counter_api/1]). -include_lib("test_server/include/test_server.hrl"). @@ -32,7 +33,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [space_in_cwd, quoting, cmd_unicode, space_in_name, bad_command, find_executable, unix_comment_in_command, deep_list_command, - large_output_command]. + large_output_command, perf_counter_api]. groups() -> []. @@ -49,6 +50,11 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_testcase(_TC,Config) -> + Config. + +end_per_testcase(_,_Config) -> + ok. space_in_cwd(doc) -> "Test that executing a command in a current working directory " @@ -278,6 +284,40 @@ large_output_command(Config) when is_list(Config) -> AAA = lists:duplicate(7000, $a), comp(AAA,os:cmd("echo " ++ AAA)). +%% Test that the os:perf_counter api works as expected +perf_counter_api(_Config) -> + + true = is_integer(os:perf_counter()), + true = os:perf_counter() > 0, + + T1 = os:perf_counter(), + timer:sleep(100), + T2 = os:perf_counter(), + TsDiff = erlang:convert_time_unit(T2 - T1, perf_counter, nano_seconds), + ct:pal("T1: ~p~n" + "T2: ~p~n" + "TsDiff: ~p~n", + [T1,T2,TsDiff]), + + %% We allow a 15% diff + true = TsDiff < 115000000, + true = TsDiff > 85000000, + + T1Ms = os:perf_counter(1000), + timer:sleep(100), + T2Ms = os:perf_counter(1000), + MsDiff = T2Ms - T1Ms, + ct:pal("T1Ms: ~p~n" + "T2Ms: ~p~n" + "MsDiff: ~p~n", + [T1Ms,T2Ms,MsDiff]), + + %% We allow a 15% diff + true = MsDiff < 115, + true = MsDiff > 85. + +%% Util functions + comp(Expected, Got) -> case strip_nl(Got) of Expected -> 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/runtime_tools/doc/src/Makefile b/lib/runtime_tools/doc/src/Makefile index 0292333f0a..38725807ae 100644 --- a/lib/runtime_tools/doc/src/Makefile +++ b/lib/runtime_tools/doc/src/Makefile @@ -41,7 +41,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/$(APPLICATION)-$(VSN) # Target Specs # ---------------------------------------------------- XML_APPLICATION_FILES = ref_man.xml -XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.xml +XML_REF3_FILES = dbg.xml dyntrace.xml erts_alloc_config.xml system_information.xml msacc.xml XML_REF6_FILES = runtime_tools_app.xml XML_PART_FILES = part_notes.xml part_notes_history.xml part.xml diff --git a/lib/runtime_tools/doc/src/msacc.xml b/lib/runtime_tools/doc/src/msacc.xml new file mode 100644 index 0000000000..129da3d230 --- /dev/null +++ b/lib/runtime_tools/doc/src/msacc.xml @@ -0,0 +1,305 @@ +<?xml version="1.0" encoding="utf-8" ?> +<!DOCTYPE erlref SYSTEM "erlref.dtd"> + +<erlref> + <header> + <copyright> + <year>2014</year><year>2014</year> + <holder>Ericsson AB. All Rights Reserved.</holder> + </copyright> + <legalnotice> + 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. + </legalnotice> + + <title>Microstate Accounting</title> + <prepared>Lukas Larsson</prepared> + <responsible></responsible> + <docno>1</docno> + <approved></approved> + <checked></checked> + <date>14-09-30</date> + <rev>A</rev> + <file>msacc.xml</file> + </header> + <module>msacc</module> + <modulesummary>Convenience functions for microstate accounting</modulesummary> + <description> + <p>This module implements some convenience functions for analyzing + microstate accounting data. For details about how to use the basic api and + what the different states represent see + <seealso marker="erts:erlang#statistics_microstate_accounting"><c> + erlang:statistics(microstate_accounting)</c></seealso>.</p> + <marker id="msacc_print_example"></marker> + <p><em>Basic Scenario</em></p> + <pre>1> <input>msacc:start(1000).</input> +ok +2> <input>msacc:print().</input> +Average thread real-time : 1000513 us +Accumulated system run-time : 2213 us +Average scheduler run-time : 1076 us + + Thread aux check_io emulator gc other port sleep + +Stats per thread: + async( 0) 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 100.00% + async( 1) 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 100.00% + aux( 1) 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 99.99% + scheduler( 1) 0.00% 0.03% 0.13% 0.00% 0.01% 0.00% 99.82% + scheduler( 2) 0.00% 0.00% 0.00% 0.00% 0.03% 0.00% 99.97% + +Stats per type: + async 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 100.00% + aux 0.00% 0.00% 0.00% 0.00% 0.00% 0.00% 99.99% + scheduler 0.00% 0.02% 0.06% 0.00% 0.02% 0.00% 99.89% +ok +</pre> + <p>This first command enables microstate accounting for 1000 milliseconds. + See <seealso marker="#start-0"><c>start/0</c></seealso>, + <seealso marker="#stop-0"><c>stop/0</c></seealso>, + <seealso marker="#reset-0"><c>reset/0</c></seealso> and + <seealso marker="#start-1"><c>start/1</c></seealso> for more details. + The second command prints the statistics gathered during that time. + First three general statistics are printed.</p> + <taglist> + <tag>Average real-time</tag> + <item>The average time spent collecting data in the threads. + This should be close to the time which data was collected. + </item> + <tag>System run-time</tag> + <item>The total run-time of all threads in the system. + This is what you get if you call <c>msacc:stats(total_runtime,Stats).</c> + </item> + <tag>Average scheduler run-time</tag> + <item>The average run-time for the schedulers. + This is the average amount of time the schedulers did not sleep.</item> + </taglist> + <p>Then one column per state is printed with a the percentage of time this + thread spent in the state out of it's own real-time. After the thread + specific time, the accumulated time for each type of thread is printed in + a similar format.</p> + <p>Since we have the average real-time and the percentage spent in each + state we can easily calculate the time spent in each state by multiplying + <c>Average thread real-time</c> with <c>Thread state %</c>, i.e. to + get the time Scheduler 1 spent in the emulator state we do + <c>1000513us * 0.13% = 1300us</c>.</p> + </description> + <datatypes> + <datatype> + <name name="msacc_data"/> + </datatype> + <datatype> + <name name="msacc_data_thread"/> + </datatype> + <datatype> + <name name="msacc_data_counters"/> + <desc><p>A map containing the different microstate accounting states and + the number of microseconds spent in it.</p></desc> + </datatype> + <datatype> + <name name="msacc_stats"/> + </datatype> + <datatype> + <name name="msacc_stats_thread"/> + <desc><p>A map containing information about a specific thread. The + percentages in the map can be either run-time or real-time depending + on if <c>runtime</c> or <c>realtime</c> was requested from + <seealso marker="#stats-2">stats/2</seealso>. <c>system</c> is the + percentage of total system time for this specific thread.</p></desc> + </datatype> + <datatype> + <name name="msacc_stats_counters"/> + <desc><p>A map containing the different microstate accounting states. Each + value in the map contains another map with the percentage of time that + this thread has spent in the specific state. Both the percentage of + <c>system</c> time and the time for that specific <c>thread</c> is part of + the map.</p></desc> + </datatype> + <datatype> + <name name="msacc_type"/> + </datatype> + <datatype> + <name name="msacc_id"/> + </datatype> + <datatype> + <name name="msacc_state"/> + <desc><p>The different states that a thread can be in. See + <seealso marker="erts:erlang#statistics_microstate_accounting"> + erlang:statistics(microstate_accounting)</seealso> for details. + </p></desc> + </datatype> + <datatype> + <name name="msacc_print_options"/> + <desc><p>The different options that can be given to + <seealso marker="#print-2"><c>print/2</c></seealso>. + </p></desc> + </datatype> + </datatypes> + <funcs> + <func> + <name name="available" arity="0"/> + <fsummary>Check if microstate accounting is available</fsummary> + <desc> + <p>This function checks whether microstate accounting + is available or not.</p> + </desc> + </func> + <func> + <name name="start" arity="0"/> + <fsummary>Start microstate accounting.</fsummary> + <desc> + <p>Start microstate accounting. Returns whether it was + previously enabled or disabled.</p> + </desc> + </func> + <func> + <name name="start" arity="1"/> + <fsummary>Start microstate accounting for a time.</fsummary> + <desc> + <p>Resets all counters and then starts microstate accounting + for the given milliseconds.</p> + </desc> + </func> + <func> + <name name="stop" arity="0"/> + <fsummary>Stop microstate accounting.</fsummary> + <desc> + <p>Stop microstate accounting. + Returns whether is was previously enabled or disabled.</p> + </desc> + </func> + <func> + <name name="reset" arity="0"/> + <fsummary>Reset microstate accounting counters</fsummary> + <desc> + <p>Reset microstate accounting counters. + Returns whether is was enabled or disabled.</p> + </desc> + </func> + <func> + <name name="print" arity="0"/> + <fsummary>Print microstate statistics</fsummary> + <desc> + <p> + Prints the current microstate accounting to standard out. + Same as + <seealso marker="#print-1"> + <c>msacc:print(msacc:stats(),#{}).</c> + </seealso> + </p> + </desc> + </func> + <func> + <name name="print" arity="1"/> + <fsummary>Print microstate statistics</fsummary> + <desc> + <p>Print the given microstate statistics values to stdout. + Same as + <seealso marker="#print-1"> + <c>msacc:print(DataOrStats,#{}).</c> + </seealso> + </p> + </desc> + </func> + <func> + <name name="print" arity="2"/> + <fsummary>Print microstate statistics</fsummary> + <desc> + <p>Print the given microstate statistics values to standard out. + With many states this can be quite verbose. See the top of this + reference manual for a brief description of what the fields mean.</p> + <p>It is possible to print more specific types of statistics by + first manipulating the <c>DataOrStats</c> using + <seealso marker="#stats-2"><c>stats/2</c></seealso>. + For instance if you want to print the percentage of run-time for each + thread you can do:</p> + <pre><input>msacc:print(msacc:stats(runtime,msacc:stats())).</input></pre> + <p>If you want to only print run-time per thread type you can do:</p> + <pre><input>msacc:print(msacc:stats(type,msacc:stats(runtime,msacc:stats()))).</input></pre> + <p><em>Options</em></p> + <taglist> + <tag><c>system</c></tag><item>Print percentage of time spent in each + state out of system time as well as thread time. + Default: false.</item> + </taglist> + </desc> + </func> + <func> + <name name="print" arity="3"/> + <fsummary>Print microstate statistics</fsummary> + <desc> + <p>Print the given microstate statistics values to the given file + or device. The other arguments behave the same way as for + <seealso marker="#print-2"><c>print/2</c></seealso>.</p> + </desc> + </func> + <func> + <name name="stats" arity="0"/> + <fsummary></fsummary> + <desc> + <p>Returns a runtime system independent version of the microstate + statistics data presented by + <seealso marker="erts:erlang#statistics_microstate_accounting"> + <c>erlang:statistics(microstate_accounting)</c></seealso>. + All counters have been normalized to be in microsecond resolution.</p> + </desc> + </func> + <func> + <name name="stats" arity="2" clause_i="1"/> + <fsummary></fsummary> + <desc> + <p>Returns the system time for the given microstate statistics values. + System time is the accumulated time of all threads.</p> + <taglist> + <tag><c>realtime</c></tag> + <item>Returns all time recorded for all threads.</item> + <tag><c>runtime</c></tag> + <item>Returns all time spent doing work for all threads, i.e. + all time not spent in the <c>sleep</c> state.</item> + </taglist> + </desc> + </func> + <func> + <name name="stats" arity="2" clause_i="2"/> + <fsummary></fsummary> + <desc> + <p>Returns fractions of real-time or run-time spent in the various + threads from the given microstate statistics values.</p> + </desc> + </func> + <func> + <name name="stats" arity="2" clause_i="3"/> + <fsummary></fsummary> + <desc> + <p>Returns a list of microstate statistics values where the values + for all threads of the same type has been merged.</p> + </desc> + </func> + <func> + <name name="to_file" arity="1"/> + <fsummary></fsummary> + <desc> + <p>Dumps the current microstate statistics counters to a file that can + be parsed with <seealso marker="kernel:file#consult/1"> + file:consult/1</seealso>.</p> + </desc> + </func> + <func> + <name name="from_file" arity="1"/> + <fsummary></fsummary> + <desc> + <p>Read a file dump produced by <seealso marker="#to_file/1"> + to_file(Filename)</seealso>.</p> + </desc> + </func> + </funcs> +</erlref> diff --git a/lib/runtime_tools/doc/src/ref_man.xml b/lib/runtime_tools/doc/src/ref_man.xml index ea0c0832a4..8657a07a30 100644 --- a/lib/runtime_tools/doc/src/ref_man.xml +++ b/lib/runtime_tools/doc/src/ref_man.xml @@ -36,6 +36,7 @@ <xi:include href="dbg.xml"/> <xi:include href="dyntrace.xml"/> <xi:include href="erts_alloc_config.xml"/> + <xi:include href="msacc.xml"/> <xi:include href="system_information.xml"/> </application> diff --git a/lib/runtime_tools/doc/src/specs.xml b/lib/runtime_tools/doc/src/specs.xml index d4c3c9dfe6..978bd39e55 100644 --- a/lib/runtime_tools/doc/src/specs.xml +++ b/lib/runtime_tools/doc/src/specs.xml @@ -1,4 +1,5 @@ <?xml version="1.0" encoding="utf-8" ?> <specs xmlns:xi="http://www.w3.org/2001/XInclude"> <xi:include href="../specs/specs_system_information.xml"/> + <xi:include href="../specs/specs_msacc.xml"/> </specs> diff --git a/lib/runtime_tools/src/Makefile b/lib/runtime_tools/src/Makefile index 99b90f9ec5..3b41184f4e 100644 --- a/lib/runtime_tools/src/Makefile +++ b/lib/runtime_tools/src/Makefile @@ -45,7 +45,9 @@ MODULES= \ percept_profile \ system_information \ observer_backend \ - ttb_autostart + ttb_autostart\ + msacc + HRL_FILES= ../include/observer_backend.hrl ERL_FILES= $(MODULES:%=%.erl) 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/runtime_tools/src/msacc.erl b/lib/runtime_tools/src/msacc.erl new file mode 100644 index 0000000000..612effa5aa --- /dev/null +++ b/lib/runtime_tools/src/msacc.erl @@ -0,0 +1,355 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-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% +%% + +%% +%% @doc Microstate accounting utility function +%% +%% This module provides a user interface for analysing +%% erlang:statistics(microstate_accounting) data. +%% + +-module(msacc). +-export([available/0, start/0, start/1, stop/0, reset/0, to_file/1, + from_file/1, stats/0, stats/2, print/0, print/1, print/2, + print/3]). + +-type msacc_data() :: [msacc_data_thread()]. + +-type msacc_data_thread() :: #{ '$type' => msacc_data, + type => msacc_type(), id => msacc_id(), + counters => msacc_data_counters() }. +-type msacc_data_counters() :: #{ msacc_state() => non_neg_integer()}. + +-type msacc_stats() :: [msacc_stats_thread()]. +-type msacc_stats_thread() :: #{ '$type' => msacc_stats, + type => msacc_type(), id => msacc_id(), + system => float(), + counters => msacc_stats_counters()}. +-type msacc_stats_counters() :: #{ msacc_state() => #{ thread => float(), + system => float()}}. + + +-type msacc_type() :: scheduler | aux | async. +-type msacc_id() :: non_neg_integer(). +-type msacc_state() :: alloc | aux | bif | busy_wait | check_io | + emulator | ets | gc | gc_fullsweep | nif | + other | port | send | sleep | timers. + +-type msacc_print_options() :: #{ system => boolean() }. + +-spec available() -> boolean(). +available() -> + try + [_|_] = erlang:statistics(microstate_accounting), + true + catch _:_ -> + false + end. + +-spec start() -> boolean(). +start() -> + erlang:system_flag(microstate_accounting, true). + +-spec stop() -> boolean(). +stop() -> + erlang:system_flag(microstate_accounting, false). + +-spec reset() -> boolean(). +reset() -> + erlang:system_flag(microstate_accounting, reset). + +-spec start(Time) -> true when + Time :: timeout(). +start(Tmo) -> + stop(), reset(), start(), + timer:sleep(Tmo), + stop(). + +-spec to_file(Filename) -> ok | {error, file:posix()} when + Filename :: file:name_all(). +to_file(Filename) -> + file:write_file(Filename, io_lib:format("~p.~n",[stats()])). + +-spec from_file(Filename) -> msacc_data() when + Filename :: file:name_all(). +from_file(Filename) -> + {ok, [Stats]} = file:consult(Filename), + Stats. + +-spec print() -> ok. +print() -> + print(stats()). + +-spec print(DataOrStats) -> ok when + DataOrStats :: msacc_data() | msacc_stats(). +print(Stats) -> + print(Stats, #{}). + +-spec print(DataOrStats, Options) -> ok when + DataOrStats :: msacc_data() | msacc_stats(), + Options :: msacc_print_options(). +print(Stats, Options) -> + print(group_leader(), Stats, Options). + +-spec print(FileOrDevice, DataOrStats, Options) -> ok when + FileOrDevice :: file:filename() | io:device(), + DataOrStats :: msacc_data() | msacc_stats(), + Options :: msacc_print_options(). +print(Filename, Stats, Options) when is_list(Filename) -> + case file:open(Filename,[write]) of + {ok, D} -> print(D, Stats, Options),file:close(D); + Error -> Error + end; +print(Device, Stats, Options) -> + DefaultOpts = #{ system => false }, + print_int(Device, Stats, maps:merge(DefaultOpts, Options)). +print_int(Device, [#{ '$type' := msacc_data, id := _Id }|_] = Stats, Options) -> + TypeStats = stats(type, Stats), + io:format(Device, "~s", [print_stats_overview(Stats, Options)]), + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_threads( + stats(realtime, Stats), Options)]), + io:format(Device, "~s", [print_stats_type( + stats(realtime, TypeStats), Options)]); +print_int(Device, [#{ '$type' := msacc_data }|_] = Stats, Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_type( + stats(realtime, Stats), Options)]); +print_int(Device, [#{ '$type' := msacc_stats, id := _Id }|_] = Stats,Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_threads(Stats, Options)]), + io:format(Device, "~s", [print_stats_type( + msacc:stats(type, Stats), Options)]); +print_int(Device, [#{ '$type' := msacc_stats }|_] = Stats, Options) -> + io:format(Device, "~s", [print_stats_header(Stats, Options)]), + io:format(Device, "~s", [print_stats_type(Stats, Options)]). + + +-spec stats() -> msacc_data(). +stats() -> + Fun = fun F(K,{PerfCount,StateCount}) -> + %% Need to handle ERTS_MSACC_STATE_COUNTERS + {F(K,PerfCount),StateCount}; + F(_K,PerfCount) -> + erlang:convert_time_unit(PerfCount, perf_counter, 1000000) + end, + UsStats = lists:map( + fun(#{ counters := Cnt } = M) -> + UsCnt = maps:map(Fun,Cnt), + M#{ '$type' => msacc_data, counters := UsCnt } + end, erlang:statistics(microstate_accounting)), + statssort(UsStats). + +-spec stats(Analysis, Stats) -> non_neg_integer() when + Analysis :: system_realtime | system_runtime, + Stats :: msacc_data(); + (Analysis, Stats) -> msacc_stats() when + Analysis :: realtime | runtime, + Stats :: msacc_data(); + (Analysis, StatsOrData) -> msacc_data() | msacc_stats() when + Analysis :: type, + StatsOrData :: msacc_data() | msacc_stats(). +stats(system_realtime, Stats) -> + lists:foldl(fun(#{ counters := Cnt }, Acc) -> + get_total(Cnt, Acc) + end, 0, Stats); +stats(system_runtime, Stats) -> + lists:foldl(fun(#{ counters := Cnt }, Acc) -> + get_total(maps:remove(sleep, Cnt), Acc) + end, 0, Stats); +stats(realtime, Stats) -> + RealTime = stats(system_realtime, Stats), + statssort([get_thread_perc(Thread, RealTime) || Thread <- Stats]); +stats(runtime, Stats) -> + RunTime = stats(system_runtime, Stats), + statssort([get_thread_perc(T#{ counters := maps:remove(sleep,Cnt)}, RunTime) + || T = #{ counters := Cnt } <- Stats]); +stats(type, Stats) -> + statssort(merge_threads(Stats, [])). + +print_stats_overview(Stats, _Options) -> + RunTime = stats(system_runtime, Stats), + RealTime = stats(system_realtime, Stats) div length(Stats), + SchedStats = [S || #{ type := scheduler } = S <- Stats], + AvgSchedRunTime = stats(system_runtime, SchedStats) div length(SchedStats), + NumSize = if + RealTime > RunTime -> length(integer_to_list(RealTime)); + true -> length(integer_to_list(RunTime)) + end, + [io_lib:format("Average thread real-time : ~*B us~n", + [NumSize, RealTime]), + io_lib:format("Accumulated system run-time : ~*B us~n", + [NumSize, RunTime]), + io_lib:format("Average scheduler run-time : ~*B us~n", + [NumSize, AvgSchedRunTime]), + io_lib:format("~n",[])]. + +print_stats_threads(Stats, Options) -> + [io_lib:format("~nStats per thread:~n", []), + [print_thread_info(Thread, Options) || Thread <- Stats]]. + +print_stats_type(Stats, Options) -> + [io_lib:format("~nStats per type:~n", []), + [print_thread_info(Thread, Options) || Thread <- Stats]]. + + +print_stats_header([#{ counters := Cnt }|_], #{ system := PrintSys }) -> + [io_lib:format("~14s", ["Thread"]), + map(fun(Counter, _) when PrintSys-> + io_lib:format("~9s ", [atom_to_list(Counter)]); + (Counter, _) -> + io_lib:format("~9s", [atom_to_list(Counter)]) + end, Cnt), + io_lib:format("~n",[])]. + +print_thread_info(#{ '$type' := msacc_stats, + counters := Cnt } = Thread, #{ system := PrintSys }) -> + [case maps:find(id, Thread) of + error -> + io_lib:format("~14s", [atom_to_list(maps:get(type, Thread))]); + {ok, Id} -> + io_lib:format("~10s(~2B)", [atom_to_list(maps:get(type,Thread)),Id]) + end, + map(fun(_Key, #{ thread := ThreadPerc, system := SystemPerc }) when PrintSys -> + io_lib:format("~6.2f%(~4.1f%)", [ThreadPerc, SystemPerc]); + (_Key, #{ thread := ThreadPerc }) -> + io_lib:format("~8.2f%", [ThreadPerc]) + end, Cnt), + io_lib:format("~n",[])]. + +get_total(Cnt, Base) -> + maps:fold(fun(_, {Val,_}, Time) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + Time + Val; + (_, Val, Time) -> Time + Val + end, Base, Cnt). + +get_thread_perc(#{ '$type' := msacc_data, counters := Cnt } = Thread, + SystemTime) -> + ThreadTime = get_total(Cnt, 0), + Thread#{ '$type' := msacc_stats, + system => percentage(ThreadTime,SystemTime), + counters => get_thread_perc(Cnt, ThreadTime, SystemTime)}. +get_thread_perc(Cnt, ThreadTime, SystemTime) -> + maps:map(fun F(Key, {Val, C}) -> + M = F(Key, Val), + M#{ cnt => C }; + F(_Key, Val) -> + #{ thread => percentage(Val, ThreadTime), + system => percentage(Val, SystemTime) } + end, Cnt). + +%% This code is a little bit messy as it has to be able to deal with +%% both [msacc_data()] and [msacc_stats()]. +merge_threads([#{ '$type' := msacc_stats, + type := Type, + counters := Cnt } = M0|R], Acc) -> + case keyfind(type, Type, Acc) of + false -> + merge_threads(R, [maps:remove(id,M0#{ threads => 1 })|Acc]); + #{ '$type' := msacc_stats, counters := Cnt0, + threads := Threads, system := System } = M -> + NewMap = M#{ counters := add_counters(Cnt, Cnt0), + system := System + maps:get(system, M0), + threads := Threads + 1}, + NewAcc = keyreplace(type, Type, NewMap, Acc), + merge_threads(R, NewAcc) + end; +merge_threads([], [#{ '$type' := msacc_stats, + system := System, + threads := Threads, + counters := Cnt} = M0|R]) -> + Counters = maps:map(fun(_,#{ thread := Thr } = Map) -> + Map#{ thread := Thr / Threads } + end, Cnt), + M = maps:remove(threads, M0), + [M#{ system := System, counters := Counters} | merge_threads([],R)]; +merge_threads([], []) -> + []; +%% The clauses below deal with msacc_data() +merge_threads([#{ '$type' := msacc_data, + type := Type, + counters := Cnt } = M0|R], Acc) -> + case keyfind(type, Type, Acc) of + false -> + merge_threads(R, [maps:remove(id,M0)|Acc]); + #{ '$type' := msacc_data, counters := Cnt0 } = M -> + NewMap = M#{ counters := add_counters(Cnt, Cnt0) }, + NewAcc = keyreplace(type, Type, NewMap, Acc), + merge_threads(R, NewAcc) + end; +merge_threads([], Acc) -> + Acc. + +add_counters(M1, M2) -> + maps:map( + fun(Key, #{ thread := Thr1, system := Sys1, cnt := Cnt1}) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + #{ thread := Thr2, system := Sys2, cnt := Cnt2} = maps:get(Key, M2), + #{ thread => Thr1 + Thr2, system => Sys1 + Sys2, + cnt => Cnt1 + Cnt2 }; + (Key, #{ thread := Thr1, system := Sys1}) -> + #{ thread := Thr2, system := Sys2} = maps:get(Key, M2), + #{ thread => Thr1 + Thr2, system => Sys1 + Sys2}; + (Key, {V1,C1}) -> + %% Have to handle ERTS_MSACC_STATE_COUNTERS + {V2,C2} = maps:get(Key, M2),{V1+V2,C1+C2}; + (Key, V1) -> maps:get(Key, M2) + V1 + end, M1). + +percentage(Divident, Divisor) -> + if Divisor == 0 andalso Divident /= 0 -> + 100.0; + Divisor == 0 -> + 0.0; + true -> + Divident / Divisor * 100 + end. + +keyfind(Key, Value, [H|T]) -> + case maps:find(Key, H) of + {ok, Value} -> + H; + _ -> + keyfind(Key, Value, T) + end; +keyfind(_, _, []) -> + false. + +keyreplace(Key, Value, NewMap, [H|T]) -> + case maps:find(Key, H) of + {ok, Value} -> + [NewMap|T]; + _ -> + [H|keyreplace(Key, Value, NewMap, T)] + end; +keyreplace(_, _, _, []) -> + []. + +statssort(Stats) -> + lists:sort(fun(#{ type := Type1, id := Id1}, + #{ type := Type2, id := Id2}) -> + {Type1, Id1} < {Type2, Id2}; + (#{ type := Type1}, #{ type := Type2}) -> + Type1 < Type2 + end, Stats). + +map(Fun,Map) -> + [ Fun(K,V) || {K,V} <- maps:to_list(Map) ]. diff --git a/lib/runtime_tools/src/runtime_tools.app.src b/lib/runtime_tools/src/runtime_tools.app.src index ad10655aa0..aeda103e72 100644 --- a/lib/runtime_tools/src/runtime_tools.app.src +++ b/lib/runtime_tools/src/runtime_tools.app.src @@ -22,7 +22,8 @@ {vsn, "%VSN%"}, {modules, [appmon_info, dbg,observer_backend,percept_profile, runtime_tools,runtime_tools_sup,erts_alloc_config, - ttb_autostart,dyntrace,system_information]}, + ttb_autostart,dyntrace,system_information, + msacc]}, {registered, [runtime_tools_sup]}, {applications, [kernel, stdlib]}, {env, []}, diff --git a/lib/runtime_tools/test/Makefile b/lib/runtime_tools/test/Makefile index dcb9082231..71ac8b1157 100644 --- a/lib/runtime_tools/test/Makefile +++ b/lib/runtime_tools/test/Makefile @@ -7,7 +7,8 @@ MODULES = \ runtime_tools_SUITE \ system_information_SUITE \ dbg_SUITE \ - erts_alloc_config_SUITE + erts_alloc_config_SUITE \ + msacc_SUITE ERL_FILES= $(MODULES:%=%.erl) diff --git a/lib/runtime_tools/test/msacc_SUITE.erl b/lib/runtime_tools/test/msacc_SUITE.erl new file mode 100644 index 0000000000..145a6d07fb --- /dev/null +++ b/lib/runtime_tools/test/msacc_SUITE.erl @@ -0,0 +1,132 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-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(msacc_SUITE). + +-include_lib("common_test/include/ct.hrl"). + +%% Test server callbacks +-export([suite/0, all/0]). + +%% Test cases +-export([ + %% API-test + api_file/1, + api_start_stop/1, + api_timer/1, + api_print/1 + ]). + +%%-------------------------------------------------------------------- +%% COMMON TEST CALLBACK FUNCTIONS +%%-------------------------------------------------------------------- +all() -> + [ + api_start_stop, + api_file, + api_timer, + api_print + ]. + +suite() -> [ + {timetrap,{minutes,1}}, + {ct_hooks,[ts_install_cth]} + ]. + +%%-------------------------------------------------------------------- +%% TEST CASES +%%-------------------------------------------------------------------- + +api_timer(_Config) -> + + %% Run msacc for about 100ms + msacc:start(100), + + %% Verify that scheduler 1 executed+slept for about 100ms + [Sched1] = [S || S = #{ type := scheduler, id := 1 } <- msacc:stats()], + + #{ counters := Cnt } = Sched1, + + %% Time should be in us + Time = maps:fold(fun(_,V,Acc) -> V + Acc end, 0, Cnt), + + if Time < 120000 andalso Time > 80000 -> ok; + true -> ct:fail({inaccurate_time, Time, msacc:stats()}) + end. + +%% We just do a basic check that none of the apis crash +api_start_stop(_Config) -> + msacc:start(), + timer:sleep(100), + msacc:stop(), + Runtime = msacc:stats(system_runtime, msacc:stats()), + Realtime = msacc:stats(system_realtime, msacc:stats()), + true = Runtime < Realtime, + + RuntimeCnt = msacc:stats(runtime, msacc:stats()), + RealtimeCnt = msacc:stats(realtime, msacc:stats()), + TypeCnt = msacc:stats(type, msacc:stats()), + + %% These should be very similar + RuntimeTypeCnt = msacc:stats(type, RuntimeCnt), + TypeRuntimeCnt = msacc:stats(runtime, TypeCnt), + lists:map(fun({#{ system := T1 },#{ system := T2}}) -> + if T1-0.5 < T2 orelse T1+0.5 > T2 -> ok; + true -> ct:fail({inaccurate_stats, RuntimeTypeCnt, + TypeRuntimeCnt}) + end + end, lists:zip(RuntimeTypeCnt, TypeRuntimeCnt)), + + %% These should be very similar + RealtimeTypeCnt = msacc:stats(type, RealtimeCnt), + TypeRealtimeCnt = msacc:stats(realtime, TypeCnt), + lists:map(fun({#{ system := T1 },#{ system := T2}}) -> + if T1-0.5 < T2 orelse T1+0.5 > T2 -> ok; + true -> ct:fail({inaccurate_stats, RealtimeTypeCnt, + TypeRealtimeCnt}) + end + end,lists:zip(RealtimeTypeCnt, TypeRealtimeCnt)), + + msacc:reset(). + +api_file(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + File = filename:join(PrivDir, "msacc.stats"), + Stats = msacc:stats(), + ok = msacc:to_file(File), + Stats = msacc:from_file(File), + + PrintFile = filename:join(PrivDir, "msacc.txt"), + msacc:print(PrintFile, Stats, #{}). + +%% We just check that it is possible to print in a couple of different ways +api_print(_Config) -> + msacc:start(100), + io:format("msacc:print(msacc:stats()).~n"), + msacc:print(msacc:stats()), + io:format("msacc:print(msacc:stats(),#{ system => true }).~n"), + msacc:print(msacc:stats(), #{ system => true }), + io:format("msacc:print(msacc:stats(runtime,msacc:stats())).~n"), + msacc:print(msacc:stats(runtime, msacc:stats())), + io:format("msacc:print(msacc:stats(type,msacc:stats())).~n"), + msacc:print(msacc:stats(type, msacc:stats())), + io:format("msacc:print(msacc:stats(realtime,msacc:stats())).~n"), + msacc:print(msacc:stats(realtime, msacc:stats())), + io:format("msacc:stats(type,msacc:stats(runtime,msacc:stats())).~n"), + msacc:print(msacc:stats(type, msacc:stats(runtime, msacc:stats()))). 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..5e9a35ab4c 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) -> 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/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_tls_dist_proxy.erl b/lib/ssl/src/ssl_tls_dist_proxy.erl index 3edd352891..1e6c6e726a 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 %%==================================================================== @@ -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 = @@ -217,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} -> @@ -227,7 +265,7 @@ 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}]), 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/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_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl index bcdefb5fca..ecf6c4d6b8 100644 --- a/lib/ssl/test/ssl_to_openssl_SUITE.erl +++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl @@ -1445,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), @@ -1480,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"], @@ -1512,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), 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/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index 6e00401dce..00cd1221fa 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). @@ -972,9 +975,7 @@ handle_call({get_crypto_key, What}, From, #state{crypto_key_f=F}=S) -> handle_call({crypto_key_fun, F}, {_,_} = From, S) -> case S#state.crypto_key_f of undefined -> - %% Don't allow tuple funs here. (They weren't allowed before, - %% so there is no reason to allow them now.) - if is_function(F), is_function(F, 1) -> + if is_function(F, 1) -> {Result, Fun, Reply} = case catch F(init) of ok -> diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl index 7036316242..bf22949870 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) -> @@ -1291,7 +1291,15 @@ init(Parent, Server) -> open_file_loop(#head{parent = Parent, server = Server}). open_file_loop(Head) -> - open_file_loop(Head, 0). + %% The Dets server pretends the file is open before + %% internal_open() has been called, which means that unless the + %% internal_open message is applied first, other processes can + %% find the pid by calling dets_server:get_pid() and do things + %% before Head has been initialized properly. + receive + ?DETS_CALL(From, {internal_open, _Ref, _Args}=Op) -> + do_apply_op(Op, From, Head, 0) + end. open_file_loop(Head, N) when element(1, Head#head.update_mode) =:= error -> open_file_loop2(Head, N); @@ -1966,7 +1974,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} -> @@ -2093,7 +2103,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, []} -> @@ -3277,11 +3302,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/ets.erl b/lib/stdlib/src/ets.erl index 847def2fd8..1fca3624dc 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -146,7 +146,7 @@ info(_) -> Tab :: tab(), Item :: compressed | fixed | heir | keypos | memory | name | named_table | node | owner | protection - | safe_fixed | size | stats | type + | safe_fixed | safe_fixed_monotonic_time | size | stats | type | write_concurrency | read_concurrency, Value :: term(). diff --git a/lib/stdlib/src/file_sorter.erl b/lib/stdlib/src/file_sorter.erl index 47adb133b0..aed857aa77 100644 --- a/lib/stdlib/src/file_sorter.erl +++ b/lib/stdlib/src/file_sorter.erl @@ -305,7 +305,6 @@ options(Option) -> options([{format, Format} | L], Opts) when Format =:= binary; Format =:= term; - is_function(Format), is_function(Format, 1) -> options(L, Opts#opts{format = Format}); options([{format, binary_term} | L], Opts) -> @@ -324,7 +323,7 @@ options([{tmpdir, Dir} | L], Opts) -> FileName -> options(L, Opts#opts{tmpdir = {dir, FileName}}) end; -options([{order, Fun} | L], Opts) when is_function(Fun), is_function(Fun, 2) -> +options([{order, Fun} | L], Opts) when is_function(Fun, 2) -> options(L, Opts#opts{order = Fun}); options([{order, Order} | L], Opts) when Order =:= ascending; Order =:= descending -> @@ -409,7 +408,7 @@ merge_terms_fun(RFun) -> case RFun(read) of end_of_input -> eof; - {Objs, NRFun} when is_function(NRFun), is_function(NRFun, 1) -> + {Objs, NRFun} when is_function(NRFun, 1) -> {_, [], Ts, _} = fun_objs(Objs, [], 0, ?MAXSIZE, I, W), {{I, Ts, ?CHUNKSIZE}, merge_terms_fun(NRFun)}; Error -> @@ -425,13 +424,12 @@ merge_bins_fun(FileName) -> Fun(A) end. -wrap_output_terms(term, OutFun, _Z) when is_function(OutFun), - is_function(OutFun, 1) -> +wrap_output_terms(term, OutFun, _Z) when is_function(OutFun, 1) -> {fun_wterms(OutFun), true}; wrap_output_terms(term, File, Z) when File =/= undefined -> {file_wterms(name, File, Z++[write]), false}; wrap_output_terms(_Format, Output, _Z) -> - {Output, is_function(Output) and is_function(Output, 1)}. + {Output, is_function(Output, 1)}. binary_term_fun() -> fun binary_to_term/1. @@ -1309,8 +1307,7 @@ infun(W) -> {end_of_input, W1}; {end_of_input, Value} -> {end_of_input, W1#w{inout_value = {value, Value}}}; - {Objs, NFun} when is_function(NFun), - is_function(NFun, 1), + {Objs, NFun} when is_function(NFun, 1), is_list(Objs) -> {cont, W#w{in = NFun}, Objs}; Error -> @@ -1333,7 +1330,7 @@ outfun(A, W) -> try (W#w.out)(A) of Reply when A =:= close -> Reply; - NF when is_function(NF), is_function(NF, 1) -> + NF when is_function(NF, 1) -> W#w{out = NF}; Error -> error(Error, W1) @@ -1358,7 +1355,7 @@ is_keyposs([Bad | _]) -> is_keyposs(Bad) -> {badarg, Bad}. -is_input(Fun) when is_function(Fun), is_function(Fun, 1) -> +is_input(Fun) when is_function(Fun, 1) -> {true, Fun}; is_input(Files) -> is_files(Files). @@ -1378,7 +1375,7 @@ is_files([], L) -> is_files(Bad, _L) -> {badarg, Bad}. -maybe_output(Fun) when is_function(Fun), is_function(Fun, 1) -> +maybe_output(Fun) when is_function(Fun, 1) -> {true, Fun}; maybe_output(File) -> case read_file_info(File) of @@ -1587,7 +1584,6 @@ fun_rterms(InFun) -> (read) -> case InFun(read) of {Ts, NInFun} when is_list(Ts), - is_function(NInFun), is_function(NInFun, 1) -> {to_bin(Ts, []), fun_rterms(NInFun)}; Else -> @@ -1600,7 +1596,7 @@ fun_wterms(OutFun) -> OutFun(close); (L) -> case OutFun(wterms_arg(L)) of - NOutFun when is_function(NOutFun), is_function(NOutFun, 1) -> + NOutFun when is_function(NOutFun, 1) -> fun_wterms(NOutFun); Else -> Else diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 960c70f255..bc70c296da 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -647,6 +647,9 @@ obsolete_1(random, _, _) -> obsolete_1(code, rehash, 0) -> {deprecated, "deprecated because the code path cache feature has been removed"}; +obsolete_1(overload, _, _) -> + {deprecated, "deprecated; will be removed in OTP 19"}; + obsolete_1(_, _, _) -> no. diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index 3ba3a88038..24e64efee7 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -808,21 +808,21 @@ options(Options0, [Key | Keys], L) when is_list(Options0) -> {ok, U}; {pre_fun, U=undefined} -> {ok, U}; - {info_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {info_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {pre_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {pre_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {post_fun, Fun} when is_function(Fun), is_function(Fun, 0) -> + {post_fun, Fun} when is_function(Fun, 0) -> {ok, Fun}; - {lookup_fun, Fun} when is_function(Fun), is_function(Fun, 2) -> + {lookup_fun, Fun} when is_function(Fun, 2) -> {ok, Fun}; {max_lookup, Max} when is_integer(Max), Max >= 0 -> {ok, Max}; {max_lookup, infinity} -> {ok, -1}; - {format_fun, Fun} when is_function(Fun), is_function(Fun, 1) -> + {format_fun, Fun} when is_function(Fun, 1) -> {ok, Fun}; - {parent_fun, Fun} when is_function(Fun), is_function(Fun, 0) -> + {parent_fun, Fun} when is_function(Fun, 0) -> {ok, Fun}; {key_equality, KE='=='} -> {ok, KE}; @@ -885,7 +885,7 @@ options(Options0, [Key | Keys], L) when is_list(Options0) -> {depth, Depth} when Depth =:= infinity; is_integer(Depth), Depth >= 0 -> {ok, Depth}; - {order, Order} when is_function(Order), is_function(Order, 2); + {order, Order} when is_function(Order, 2); (Order =:= ascending); (Order =:= descending) -> {ok, Order}; 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/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index e061e16e4c..ad8829c471 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -53,7 +53,8 @@ simultaneous_open/1, insert_new/1, repair_continuation/1, otp_5487/1, otp_6206/1, otp_6359/1, otp_4738/1, otp_7146/1, otp_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1, - otp_8923/1, otp_9282/1, otp_11245/1, otp_11709/1, otp_13229/1]). + otp_8923/1, otp_9282/1, otp_11245/1, otp_11709/1, otp_13229/1, + otp_13260/1]). -export([dets_dirty_loop/0]). @@ -111,7 +112,7 @@ all() -> insert_new, repair_continuation, otp_5487, otp_6206, otp_6359, otp_4738, otp_7146, otp_8070, otp_8856, otp_8898, otp_8899, otp_8903, otp_8923, otp_9282, otp_11245, otp_11709, - otp_13229 + otp_13229, otp_13260 ]. groups() -> @@ -1877,9 +1878,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, '_')), @@ -4001,6 +4026,54 @@ otp_13229(_Config) -> ok end. +otp_13260(doc) -> + ["OTP-13260. Race when opening a table."]; +otp_13260(Config) -> + [ok] = lists:usort([otp_13260_1(Config) || _ <- lists:seq(1, 3)]), + ok. + +otp_13260_1(Config) -> + Tab = otp_13260, + File = filename(Tab, Config), + N = 20, + P = self(), + Pids = [spawn_link(fun() -> counter(P, Tab, File) end) || + _ <- lists:seq(1, N)], + Rs = rec(Pids), + true = lists:all(fun(R) -> is_integer(R) end, Rs), + wait_for_close(Tab). + +rec([]) -> + []; +rec([Pid | Pids]) -> + receive {Pid, R} -> + [R | rec(Pids)] + end. + +%% One may have to run the test several times to trigger the bug. +counter(P, Tab, File) -> + Key = key, + N = case catch dets:update_counter(Tab, Key, 1) of + {'EXIT', _} -> + {ok, Tab} = dets:open_file(Tab, [{file, File}]), + ok = dets:insert(Tab, {Key, 1}), + dets:update_counter(Tab, Key, 1); + N1 when is_integer(N1) -> + N1; + DetsBug -> + DetsBug + end, + P ! {self(), N}. + +wait_for_close(Tab) -> + case dets:info(Tab, owner) of + undefined -> + ok; + _ -> + timer:sleep(100), + wait_for_close(Tab) + end. + %% %% Parts common to several test cases %% diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 3e63d19213..39d9ddaaa7 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -3968,15 +3968,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), @@ -4022,6 +4044,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). @@ -5512,7 +5535,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/tools/src/cover.erl b/lib/tools/src/cover.erl index 69e0f59b68..3732b0fc85 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -2003,7 +2003,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/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl index 483ea9774e..8264747a3b 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. @@ -28,7 +28,8 @@ 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, compile_beam_no_file], + 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, @@ -1252,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" @@ -1546,8 +1547,10 @@ comprehension_8188(Cf) -> " true]. \n" % 2 " two() -> 2">>, Cf), % 1 - ?line [{{t,1},1}, - {{t,2},2}, + %% The template cannot have a counter since it is not allowed to + %% be a block. + ?line [% {{t,1},1}, + %% {{t,2},2}, {{t,3},1}, {{t,4},1}, {{t,5},0}, @@ -1556,8 +1559,8 @@ comprehension_8188(Cf) -> {{t,12},3}, {{t,13},2}, {{t,14},2}] = - analyse_expr(<<"<< \n" % 1 - " << (X*2) >> || \n" % 2 + analyse_expr(<<"<< \n" % 1 (now: 0) + " << (X*2) >> || \n" % 2 (now: 0) " <<X>> <= << (case two() of\n" " 2 -> 1;\n" % 1 " _ -> 2\n" % 0 @@ -1571,8 +1574,8 @@ comprehension_8188(Cf) -> " true >>.\n" % 2 "two() -> 2">>, Cf), - ?line [{{t,1},1}, - {{t,2},4}, + ?line [% {{t,1},1}, + %% {{t,2},4}, {{t,4},1}, {{t,6},1}, {{t,7},0}, @@ -1580,8 +1583,8 @@ comprehension_8188(Cf) -> {{t,11},2}, {{t,12},4}, {{t,13},1}] = - analyse_expr(<<"<< \n" % 1 - " << (2)\n" % 4 + analyse_expr(<<"<< \n" % 1 (now: 0) + " << (2)\n" % 4 (now: 0) " :(8) >> || \n" " <<X>> <= << 1,\n" % 1 " (case two() of \n" @@ -1745,6 +1748,23 @@ 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/typer/src/typer.erl b/lib/typer/src/typer.erl index 562530c868..5c82750a21 100644 --- a/lib/typer/src/typer.erl +++ b/lib/typer/src/typer.erl @@ -2,7 +2,7 @@ %%----------------------------------------------------------------------- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2015. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -137,11 +137,14 @@ extract(#analysis{macros = Macros, NewCodeServer = try NewRecords = dialyzer_codeserver:get_temp_records(CodeServer1), + NewExpTypes = dialyzer_codeserver:get_temp_exported_types(CodeServer1), + case sets:size(NewExpTypes) of 0 -> ok end, OldRecords = dialyzer_plt:get_types(TrustPLT), % XXX change to the PLT? MergedRecords = dialyzer_utils:merge_records(NewRecords, OldRecords), CodeServer2 = dialyzer_codeserver:set_temp_records(MergedRecords, CodeServer1), - CodeServer3 = dialyzer_utils:process_record_remote_types(CodeServer2), - dialyzer_contracts:process_contract_remote_types(CodeServer3) + CodeServer3 = dialyzer_codeserver:finalize_exported_types(NewExpTypes, CodeServer2), + CodeServer4 = dialyzer_utils:process_record_remote_types(CodeServer3), + dialyzer_contracts:process_contract_remote_types(CodeServer4) catch throw:{error, ErrorMsg} -> compile_error(ErrorMsg) @@ -845,8 +848,7 @@ collect_info(Analysis) -> %% io:format("Merged Records ~p",[MergedRecords]), TmpCServer1 = dialyzer_codeserver:set_temp_records(MergedRecords, TmpCServer), TmpCServer2 = - dialyzer_codeserver:insert_temp_exported_types(MergedExpTypes, - TmpCServer1), + dialyzer_codeserver:finalize_exported_types(MergedExpTypes, TmpCServer1), TmpCServer3 = dialyzer_utils:process_record_remote_types(TmpCServer2), dialyzer_contracts:process_contract_remote_types(TmpCServer3) catch |