aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/eunit/include/eunit.hrl264
-rw-r--r--lib/eunit/src/Makefile2
-rw-r--r--lib/hipe/main/hipe.erl70
-rw-r--r--lib/kernel/src/code.erl9
-rw-r--r--lib/kernel/src/code_server.erl70
-rw-r--r--lib/kernel/src/hipe_unified_loader.erl231
-rw-r--r--lib/kernel/test/code_SUITE.erl16
-rw-r--r--lib/kernel/test/gen_tcp_misc_SUITE.erl94
-rw-r--r--lib/ssl/doc/src/ssl.xml21
-rw-r--r--lib/ssl/src/dtls_connection.erl1
-rw-r--r--lib/ssl/src/ssl.appup.src10
-rw-r--r--lib/ssl/src/ssl.erl7
-rw-r--r--lib/ssl/src/ssl_internal.hrl1
-rw-r--r--lib/ssl/src/tls_connection.erl1
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl57
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl2
-rw-r--r--lib/stdlib/doc/src/Makefile2
-rw-r--r--lib/stdlib/doc/src/assert_hrl.xml160
-rw-r--r--lib/stdlib/doc/src/ref_man.xml1
-rw-r--r--lib/stdlib/include/assert.hrl260
-rw-r--r--lib/stdlib/src/Makefile1
-rw-r--r--lib/stdlib/test/Makefile3
-rw-r--r--lib/stdlib/test/stdlib_SUITE.erl67
23 files changed, 907 insertions, 443 deletions
diff --git a/lib/eunit/include/eunit.hrl b/lib/eunit/include/eunit.hrl
index 53d291430d..88e9d6c19b 100644
--- a/lib/eunit/include/eunit.hrl
+++ b/lib/eunit/include/eunit.hrl
@@ -15,11 +15,14 @@
%%
%% Copyright (C) 2004-2006 Mickaël Rémond, Richard Carlsson
+-ifndef(EUNIT_HRL).
+-define(EUNIT_HRL, true).
+
%% Including this file turns on testing and defines TEST, unless NOTEST
%% is defined before the file is included. If both NOTEST and TEST are
%% already defined, then TEST takes precedence, and NOTEST will become
%% undefined.
-%%
+%%
%% If NODEBUG is defined before this file is included, the debug macros
%% are disabled, unless DEBUG is also defined, in which case NODEBUG
%% will become undefined. NODEBUG also implies NOASSERT, unless testing
@@ -31,14 +34,10 @@
%% even if NODEBUG is defined. If both ASSERT and NOASSERT are defined
%% before the file is included, then ASSERT takes precedence, and NOASSERT
%% will become undefined regardless of TEST.
-%%
+%%
%% After including this file, EUNIT will be defined if and only if TEST
%% is defined.
--ifndef(EUNIT_HRL).
--define(EUNIT_HRL, true).
-
-
%% allow defining TEST to override NOTEST
-ifdef(TEST).
-undef(NOTEST).
@@ -49,13 +48,6 @@
-undef(NODEBUG).
-endif.
-%% allow NODEBUG to imply NOASSERT, unless overridden below
--ifdef(NODEBUG).
--ifndef(NOASSERT).
--define(NOASSERT, true).
--endif.
--endif.
-
%% note that the main switch used within this file is NOTEST; however,
%% both TEST and EUNIT may be used to check whether testing is enabled
-ifndef(NOTEST).
@@ -70,10 +62,8 @@
-undef(EUNIT).
-endif.
-%% allow ASSERT to override NOASSERT (regardless of TEST/NOTEST)
--ifdef(ASSERT).
--undef(NOASSERT).
--endif.
+%% include the assert macros; ASSERT overrides NOASSERT if defined
+-include_lib("stdlib/include/assert.hrl").
%% Parse transforms for automatic exporting/stripping of test functions.
%% (Note that although automatic stripping is convenient, it will make
@@ -91,7 +81,7 @@
%% All macros should be available even if testing is turned off, and
%% should preferably not require EUnit to be present at runtime.
-%%
+%%
%% We must use fun-call wrappers ((fun () -> ... end)()) to avoid
%% exporting local variables, and furthermore we only use variable names
%% prefixed with "__", that hopefully will not be bound outside the fun.
@@ -128,211 +118,24 @@
current_function)))).
-endif.
-%% The plain assert macro should be defined to do nothing if this file
-%% is included when debugging/testing is turned off.
--ifdef(NOASSERT).
--ifndef(assert).
--define(assert(BoolExpr),ok).
--endif.
--else.
-%% The assert macro is written the way it is so as not to cause warnings
-%% for clauses that cannot match, even if the expression is a constant.
--undef(assert).
--define(assert(BoolExpr),
- begin
- ((fun () ->
- case (BoolExpr) of
- true -> ok;
- __V -> erlang:error({assertion_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??BoolExpr)},
- {expected, true},
- {value, case __V of false -> __V;
- _ -> {not_a_boolean,__V}
- end}]})
- end
- end)())
- end).
--endif.
--define(assertNot(BoolExpr), ?assert(not (BoolExpr))).
+%% General test macros
-define(_test(Expr), {?LINE, fun () -> (Expr) end}).
-
-define(_assert(BoolExpr), ?_test(?assert(BoolExpr))).
-
-define(_assertNot(BoolExpr), ?_assert(not (BoolExpr))).
-
-%% This is mostly a convenience which gives more detailed reports.
-%% Note: Guard is a guarded pattern, and can not be used for value.
--ifdef(NOASSERT).
--define(assertMatch(Guard, Expr), ok).
--else.
--define(assertMatch(Guard, Expr),
- begin
- ((fun () ->
- case (Expr) of
- Guard -> ok;
- __V -> erlang:error({assertMatch_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {pattern, (??Guard)},
- {value, __V}]})
- end
- end)())
- end).
--endif.
-define(_assertMatch(Guard, Expr), ?_test(?assertMatch(Guard, Expr))).
-
-%% This is the inverse case of assertMatch, for convenience.
--ifdef(NOASSERT).
--define(assertNotMatch(Guard, Expr), ok).
--else.
--define(assertNotMatch(Guard, Expr),
- begin
- ((fun () ->
- __V = (Expr),
- case __V of
- Guard -> erlang:error({assertNotMatch_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {pattern, (??Guard)},
- {value, __V}]});
- _ -> ok
- end
- end)())
- end).
--endif.
-define(_assertNotMatch(Guard, Expr), ?_test(?assertNotMatch(Guard, Expr))).
-
-%% This is a convenience macro which gives more detailed reports when
-%% the expected LHS value is not a pattern, but a computed value
--ifdef(NOASSERT).
--define(assertEqual(Expect, Expr), ok).
--else.
--define(assertEqual(Expect, Expr),
- begin
- ((fun (__X) ->
- case (Expr) of
- __X -> ok;
- __V -> erlang:error({assertEqual_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {expected, __X},
- {value, __V}]})
- end
- end)(Expect))
- end).
--endif.
-define(_assertEqual(Expect, Expr), ?_test(?assertEqual(Expect, Expr))).
-
-%% This is the inverse case of assertEqual, for convenience.
--ifdef(NOASSERT).
--define(assertNotEqual(Unexpected, Expr), ok).
--else.
--define(assertNotEqual(Unexpected, Expr),
- begin
- ((fun (__X) ->
- case (Expr) of
- __X -> erlang:error({assertNotEqual_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {value, __X}]});
- _ -> ok
- end
- end)(Unexpected))
- end).
--endif.
-define(_assertNotEqual(Unexpected, Expr),
?_test(?assertNotEqual(Unexpected, Expr))).
-
-%% Note: Class and Term are patterns, and can not be used for value.
-%% Term can be a guarded pattern, but Class cannot.
--ifdef(NOASSERT).
--define(assertException(Class, Term, Expr), ok).
--else.
--define(assertException(Class, Term, Expr),
- begin
- ((fun () ->
- try (Expr) of
- __V -> erlang:error({assertException_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {pattern,
- "{ "++(??Class)++" , "++(??Term)
- ++" , [...] }"},
- {unexpected_success, __V}]})
- catch
- Class:Term -> ok;
- __C:__T ->
- erlang:error({assertException_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {pattern,
- "{ "++(??Class)++" , "++(??Term)
- ++" , [...] }"},
- {unexpected_exception,
- {__C, __T,
- erlang:get_stacktrace()}}]})
- end
- end)())
- end).
--endif.
-
--define(assertError(Term, Expr), ?assertException(error, Term, Expr)).
--define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)).
--define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)).
-
-define(_assertException(Class, Term, Expr),
?_test(?assertException(Class, Term, Expr))).
-define(_assertError(Term, Expr), ?_assertException(error, Term, Expr)).
-define(_assertExit(Term, Expr), ?_assertException(exit, Term, Expr)).
-define(_assertThrow(Term, Expr), ?_assertException(throw, Term, Expr)).
-
-%% This is the inverse case of assertException, for convenience.
-%% Note: Class and Term are patterns, and can not be used for value.
-%% Both Class and Term can be guarded patterns.
--ifdef(NOASSERT).
--define(assertNotException(Class, Term, Expr), ok).
--else.
--define(assertNotException(Class, Term, Expr),
- begin
- ((fun () ->
- try (Expr) of
- _ -> ok
- catch
- __C:__T ->
- case __C of
- Class ->
- case __T of
- Term ->
- erlang:error({assertNotException_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {expression, (??Expr)},
- {pattern,
- "{ "++(??Class)++" , "
- ++(??Term)++" , [...] }"},
- {unexpected_exception,
- {__C, __T,
- erlang:get_stacktrace()
- }}]});
- _ -> ok
- end;
- _ -> ok
- end
- end
- end)())
- end).
--endif.
-define(_assertNotException(Class, Term, Expr),
?_test(?assertNotException(Class, Term, Expr))).
+-define(_assertReceive(Guard, Expr), ?_test(?assertReceive(Guard, Expr))).
%% Macros for running operating system commands. (Note that these
%% require EUnit to be present at runtime, or at least eunit_lib.)
@@ -364,18 +167,18 @@
-else.
-define(assertCmdStatus(N, Cmd),
begin
- ((fun () ->
- case ?_cmd_(Cmd) of
- {(N), _} -> ok;
- {__N, _} -> erlang:error({assertCmd_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {command, (Cmd)},
- {expected_status,(N)},
- {status,__N}]})
- end
- end)())
- end).
+ ((fun () ->
+ case ?_cmd_(Cmd) of
+ {(N), _} -> ok;
+ {__N, _} -> erlang:error({assertCmd_failed,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {command, (Cmd)},
+ {expected_status,(N)},
+ {status,__N}]})
+ end
+ end)())
+ end).
-endif.
-define(assertCmd(Cmd), ?assertCmdStatus(0, Cmd)).
@@ -384,17 +187,17 @@
-else.
-define(assertCmdOutput(T, Cmd),
begin
- ((fun () ->
- case ?_cmd_(Cmd) of
- {_, (T)} -> ok;
- {_, __T} -> erlang:error({assertCmdOutput_failed,
- [{module, ?MODULE},
- {line, ?LINE},
- {command,(Cmd)},
- {expected_output,(T)},
- {output,__T}]})
- end
- end)())
+ ((fun () ->
+ case ?_cmd_(Cmd) of
+ {_, (T)} -> ok;
+ {_, __T} -> erlang:error({assertCmdOutput_failed,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {command,(Cmd)},
+ {expected_output,(T)},
+ {output,__T}]})
+ end
+ end)())
end).
-endif.
@@ -439,5 +242,4 @@
end).
-endif.
-
-endif. % EUNIT_HRL
diff --git a/lib/eunit/src/Makefile b/lib/eunit/src/Makefile
index 47aef104ff..86a6d8831e 100644
--- a/lib/eunit/src/Makefile
+++ b/lib/eunit/src/Makefile
@@ -24,7 +24,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/eunit-$(VSN)
EBIN = ../ebin
INCLUDE=../include
-ERL_COMPILE_FLAGS += -pa $(EBIN) -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard
+ERL_COMPILE_FLAGS += -pa $(EBIN) -pa ../../stdlib/ebin -I$(INCLUDE) +warn_unused_vars +nowarn_shadow_vars +warn_unused_import +warn_obsolete_guard
PARSE_TRANSFORM = eunit_autoexport.erl
diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl
index 539ce883c0..b614f5f1ab 100644
--- a/lib/hipe/main/hipe.erl
+++ b/lib/hipe/main/hipe.erl
@@ -649,8 +649,9 @@ run_compiler_1(DisasmFun, IcodeFun, Options) ->
%% The full option expansion is not done
%% until the DisasmFun returns.
{Code, CompOpts} = DisasmFun(Options),
- Opts0 = expand_options(Options ++ CompOpts),
- Opts =
+ Opts0 = expand_options(Options ++ CompOpts,
+ get(hipe_target_arch)),
+ Opts =
case proplists:get_bool(to_llvm, Opts0) andalso
not llvm_support_available() of
true ->
@@ -895,8 +896,7 @@ do_load(Mod, Bin, BeamBinOrPath) when is_binary(BeamBinOrPath);
code:load_native_sticky(Mod, Bin, Beam);
false ->
%% Normal loading of a whole module
- Architecture = erlang:system_info(hipe_architecture),
- ChunkName = hipe_unified_loader:chunk_name(Architecture),
+ ChunkName = hipe_unified_loader:chunk_name(HostArch),
{ok, _, Chunks0} = beam_lib:all_chunks(BeamBinOrPath),
Chunks = [{ChunkName, Bin}|lists:keydelete(ChunkName, 1, Chunks0)],
{ok, BeamPlusNative} = beam_lib:build_module(Chunks),
@@ -933,9 +933,9 @@ assemble(CompiledCode, Closures, Exports, Options) ->
%% but can be overridden by passing an option {target, Target}.
set_architecture(Options) ->
- put(hipe_host_arch, erlang:system_info(hipe_architecture)),
- put(hipe_target_arch,
- proplists:get_value(target, Options, get(hipe_host_arch))),
+ HostArch = erlang:system_info(hipe_architecture),
+ put(hipe_host_arch, HostArch),
+ put(hipe_target_arch, proplists:get_value(target, Options, HostArch)),
ok.
%% This sets up some globally accessed stuff that are needed by the
@@ -943,7 +943,7 @@ set_architecture(Options) ->
%% Therefore, this expands the current set of options for local use.
pre_init(Opts) ->
- Options = expand_options(Opts),
+ Options = expand_options(Opts, get(hipe_target_arch)),
%% Initialise some counters used for measurements and benchmarking. If
%% the option 'measure_regalloc' is given the compilation will return
%% a keylist with the counter values.
@@ -1105,10 +1105,10 @@ help_hiper() ->
-spec help_options() -> 'ok'.
help_options() ->
- set_architecture([]), %% needed for target-specific option expansion
- O1 = expand_options([o1]),
- O2 = expand_options([o2]),
- O3 = expand_options([o3]),
+ HostArch = erlang:system_info(hipe_architecture),
+ O1 = expand_options([o1], HostArch),
+ O2 = expand_options([o2], HostArch),
+ O3 = expand_options([o3], HostArch),
io:format("HiPE Compiler Options\n" ++
" Boolean-valued options generally have corresponding " ++
"aliases `no_...',\n" ++
@@ -1134,7 +1134,7 @@ help_options() ->
[ordsets:from_list([verbose, debug, time, load, pp_beam,
pp_icode, pp_rtl, pp_native, pp_asm,
timeout]),
- expand_options([pp_all]),
+ expand_options([pp_all], HostArch),
O1 -- [o1],
(O2 -- O1) -- [o2],
(O3 -- O2) -- [o3]]),
@@ -1232,8 +1232,8 @@ option_text(Opt) when is_atom(Opt) ->
-spec help_option(comp_option()) -> 'ok'.
help_option(Opt) ->
- set_architecture([]), %% needed for target-specific option expansion
- case expand_options([Opt]) of
+ HostArch = erlang:system_info(hipe_architecture),
+ case expand_options([Opt], HostArch) of
[Opt] ->
Name = if is_atom(Opt) -> Opt;
tuple_size(Opt) =:= 2 -> element(1, Opt)
@@ -1364,11 +1364,11 @@ opt_keys() ->
%% verbose_spills,
x87].
-%% Definitions:
+%% Definitions:
-o1_opts() ->
+o1_opts(TargetArch) ->
Common = [inline_fp, pmatch, peephole],
- case get(hipe_target_arch) of
+ case TargetArch of
ultrasparc ->
Common;
powerpc ->
@@ -1385,13 +1385,13 @@ o1_opts() ->
?EXIT({executing_on_an_unsupported_architecture,Arch})
end.
-o2_opts() ->
+o2_opts(TargetArch) ->
Common = [icode_ssa_const_prop, icode_ssa_copy_prop, % icode_ssa_struct_reuse,
icode_type, icode_inline_bifs, rtl_lcm,
rtl_ssa, rtl_ssa_const_prop,
- spillmin_color, use_indexing, remove_comments,
- concurrent_comp, binary_opt | o1_opts()],
- case get(hipe_target_arch) of
+ spillmin_color, use_indexing, remove_comments,
+ concurrent_comp, binary_opt | o1_opts(TargetArch)],
+ case TargetArch of
ultrasparc ->
Common;
powerpc ->
@@ -1409,9 +1409,9 @@ o2_opts() ->
?EXIT({executing_on_an_unsupported_architecture,Arch})
end.
-o3_opts() ->
- Common = [icode_range, {regalloc,coalescing} | o2_opts()],
- case get(hipe_target_arch) of
+o3_opts(TargetArch) ->
+ Common = [icode_range, {regalloc,coalescing} | o2_opts(TargetArch)],
+ case TargetArch of
ultrasparc ->
Common;
powerpc ->
@@ -1489,18 +1489,18 @@ opt_aliases() ->
opt_basic_expansions() ->
[{pp_all, [pp_beam, pp_icode, pp_rtl, pp_native]}].
-opt_expansions() ->
- [{o1, o1_opts()},
- {o2, o2_opts()},
- {o3, o3_opts()},
+opt_expansions(TargetArch) ->
+ [{o1, o1_opts(TargetArch)},
+ {o2, o2_opts(TargetArch)},
+ {o3, o3_opts(TargetArch)},
{to_llvm, llvm_opts(o3)},
{{to_llvm, o0}, llvm_opts(o0)},
{{to_llvm, o1}, llvm_opts(o1)},
{{to_llvm, o2}, llvm_opts(o2)},
{{to_llvm, o3}, llvm_opts(o3)},
{x87, [x87, inline_fp]},
- {inline_fp, case get(hipe_target_arch) of %% XXX: Temporary until x86
- x86 -> [x87, inline_fp]; %% has sse2
+ {inline_fp, case TargetArch of %% XXX: Temporary until x86 has sse2
+ x86 -> [x87, inline_fp];
_ -> [inline_fp] end}].
llvm_opts(O) ->
@@ -1523,18 +1523,18 @@ expand_kt2(Opts) ->
[{use_callgraph, fixpoint}, core,
{core_transform, cerl_typean}]}]}]).
-%% Note that set_architecture/1 must be called first, and that the given
+%% Note that the given
%% list should contain the total set of options, since things like 'o2'
%% are expanded here. Basic expansions are processed here also, since
%% this function is called from the help functions.
--spec expand_options(comp_options()) -> comp_options().
+-spec expand_options(comp_options(), hipe_architecture()) -> comp_options().
-expand_options(Opts) ->
+expand_options(Opts, TargetArch) ->
proplists:normalize(Opts, [{negations, opt_negations()},
{aliases, opt_aliases()},
{expand, opt_basic_expansions()},
- {expand, opt_expansions()}]).
+ {expand, opt_expansions(TargetArch)}]).
-spec check_options(comp_options()) -> 'ok'.
diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl
index 65045666ec..580c070389 100644
--- a/lib/kernel/src/code.erl
+++ b/lib/kernel/src/code.erl
@@ -339,7 +339,8 @@ do_start(Flags) ->
ok
end,
%% Quietly load native code for all modules loaded so far
- load_native_code_for_all_loaded(),
+ Architecture = erlang:system_info(hipe_architecture),
+ load_native_code_for_all_loaded(Architecture),
Ok2;
Other ->
Other
@@ -554,9 +555,9 @@ has_ext(Ext, Extlen, File) ->
%%% Silently load native code for all modules loaded so far.
%%%
--spec load_native_code_for_all_loaded() -> ok.
-load_native_code_for_all_loaded() ->
- Architecture = erlang:system_info(hipe_architecture),
+load_native_code_for_all_loaded(undefined) ->
+ ok;
+load_native_code_for_all_loaded(Architecture) ->
try hipe_unified_loader:chunk_name(Architecture) of
ChunkTag ->
Loaded = all_loaded(),
diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
index 819554ce74..a4342715ef 100644
--- a/lib/kernel/src/code_server.erl
+++ b/lib/kernel/src/code_server.erl
@@ -324,12 +324,15 @@ handle_call({load_binary,Mod,File,Bin}, Caller, S) ->
do_load_binary(Mod, File, Bin, Caller, S);
handle_call({load_native_partial,Mod,Bin}, {_From,_Tag}, S) ->
- Result = (catch hipe_unified_loader:load(Mod, Bin)),
+ Architecture = erlang:system_info(hipe_architecture),
+ Result = (catch hipe_unified_loader:load(Mod, Bin, Architecture)),
Status = hipe_result_to_status(Result),
{reply,Status,S};
handle_call({load_native_sticky,Mod,Bin,WholeModule}, {_From,_Tag}, S) ->
- Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule)),
+ Architecture = erlang:system_info(hipe_architecture),
+ Result = (catch hipe_unified_loader:load_module(Mod, Bin, WholeModule,
+ Architecture)),
Status = hipe_result_to_status(Result),
{reply,Status,S};
@@ -1259,30 +1262,40 @@ try_load_module_1(File, Mod, Bin, Caller, #state{moddb=Db}=St) ->
error_msg("Can't load module that resides in sticky dir\n",[]),
{reply,{error,sticky_directory},St};
false ->
- case catch load_native_code(Mod, Bin) of
- {module,Mod} = Module ->
- ets:insert(Db, {Mod,File}),
- {reply,Module,St};
- no_native ->
- case erlang:load_module(Mod, Bin) of
- {module,Mod} = Module ->
- ets:insert(Db, {Mod,File}),
- post_beam_load(Mod),
- {reply,Module,St};
- {error,on_load} ->
- handle_on_load(Mod, File, Caller, St);
- {error,What} = Error ->
- error_msg("Loading of ~ts failed: ~p\n", [File, What]),
- {reply,Error,St}
- end;
- Error ->
- error_msg("Native loading of ~ts failed: ~p\n",
- [File,Error]),
- {reply,ok,St}
- end
+ Architecture = erlang:system_info(hipe_architecture),
+ try_load_module_2(File, Mod, Bin, Caller, Architecture, St)
+ end.
+
+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
+ {module,Mod} = Module ->
+ ets:insert(Db, {Mod,File}),
+ {reply,Module,St};
+ no_native ->
+ try_load_module_3(File, Mod, Bin, Caller, Architecture, St);
+ Error ->
+ error_msg("Native loading of ~ts failed: ~p\n", [File,Error]),
+ {reply,ok,St}
+ end.
+
+try_load_module_3(File, Mod, Bin, Caller, Architecture,
+ #state{moddb=Db}=St) ->
+ case erlang:load_module(Mod, Bin) of
+ {module,Mod} = Module ->
+ ets:insert(Db, {Mod,File}),
+ post_beam_load(Mod, Architecture),
+ {reply,Module,St};
+ {error,on_load} ->
+ handle_on_load(Mod, File, Caller, St);
+ {error,What} = Error ->
+ error_msg("Loading of ~ts failed: ~p\n", [File, What]),
+ {reply,Error,St}
end.
-load_native_code(Mod, Bin) ->
+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
@@ -1291,7 +1304,8 @@ load_native_code(Mod, Bin) ->
false ->
no_native;
true ->
- Result = hipe_unified_loader:load_native_code(Mod, Bin),
+ Result = hipe_unified_loader:load_native_code(Mod, Bin,
+ Architecture),
case Result of
{module,_} ->
put(?ANY_NATIVE_CODE_LOADED, true);
@@ -1310,12 +1324,12 @@ hipe_result_to_status(Result) ->
{error,Result}
end.
-post_beam_load(Mod) ->
- %% post_beam_load/1 can potentially be very expensive because it
+post_beam_load(Mod, Architecture) ->
+ %% post_beam_load/2 can potentially be very expensive because it
%% blocks multi-scheduling; thus we want to avoid the call if we
%% know that it is not needed.
case get(?ANY_NATIVE_CODE_LOADED) of
- true -> hipe_unified_loader:post_beam_load(Mod);
+ true -> hipe_unified_loader:post_beam_load(Mod, Architecture);
false -> ok
end.
diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl
index 49d4a8fe54..ddbbc548dd 100644
--- a/lib/kernel/src/hipe_unified_loader.erl
+++ b/lib/kernel/src/hipe_unified_loader.erl
@@ -43,10 +43,10 @@
-export([chunk_name/1,
%% Only the code and code_server modules may call the entries below!
- load_native_code/2,
- post_beam_load/1,
- load_module/3,
- load/2]).
+ load_native_code/3,
+ post_beam_load/2,
+ load_module/4,
+ load/3]).
%%-define(DEBUG,true).
-define(DO_ASSERT,true).
@@ -82,58 +82,57 @@ chunk_name(Architecture) ->
%% HW32 %% HiPE, x86, Win32
end.
+word_size(Architecture) ->
+ case Architecture of
+ amd64 -> 8;
+ ppc64 -> 8;
+ _ -> 4
+ end.
+
%%========================================================================
--spec load_native_code(Mod, binary()) -> 'no_native' | {'module', Mod}
- when Mod :: atom().
+-spec load_native_code(Mod, binary(), hipe_architecture()) ->
+ 'no_native' | {'module', Mod} when Mod :: atom().
%% @doc
%% Loads the native code of a module Mod.
%% Returns {module,Mod} on success (for compatibility with
%% code:load_file/1) and the atom `no_native' on failure.
-load_native_code(Mod, Bin) when is_atom(Mod), is_binary(Bin) ->
- Architecture = erlang:system_info(hipe_architecture),
- try chunk_name(Architecture) of
- ChunkTag ->
- %% patch_to_emu(Mod),
- case code:get_chunk(Bin, ChunkTag) of
- undefined -> no_native;
- NativeCode when is_binary(NativeCode) ->
- erlang:system_flag(multi_scheduling, block),
- try
- OldReferencesToPatch = patch_to_emu_step1(Mod),
- case load_module(Mod, NativeCode, Bin, OldReferencesToPatch) of
- bad_crc -> no_native;
- Result -> Result
- end
- after
- erlang:system_flag(multi_scheduling, unblock)
- end
+load_native_code(_Mod, _Bin, undefined) ->
+ no_native;
+load_native_code(Mod, Bin, Architecture) when is_atom(Mod), is_binary(Bin) ->
+ %% patch_to_emu(Mod),
+ case code:get_chunk(Bin, chunk_name(Architecture)) of
+ undefined -> no_native;
+ NativeCode when is_binary(NativeCode) ->
+ erlang:system_flag(multi_scheduling, block),
+ try
+ OldReferencesToPatch = patch_to_emu_step1(Mod),
+ case load_module(Mod, NativeCode, Bin, OldReferencesToPatch,
+ Architecture) of
+ bad_crc -> no_native;
+ Result -> Result
+ end
+ after
+ erlang:system_flag(multi_scheduling, unblock)
end
- catch
- _:_ ->
- %% Unknown HiPE architecture. Can't happen (in principle).
- no_native
end.
%%========================================================================
--spec post_beam_load(atom()) -> 'ok'.
+-spec post_beam_load(atom(), hipe_architecture()) -> 'ok'.
-post_beam_load(Mod) when is_atom(Mod) ->
- Architecture = erlang:system_info(hipe_architecture),
- try chunk_name(Architecture) of
- _ChunkTag ->
- erlang:system_flag(multi_scheduling, block),
- try
- patch_to_emu(Mod)
- after
- erlang:system_flag(multi_scheduling, unblock)
- end
- catch
- _:_ ->
- ok
- end.
+%% does nothing on a hipe-disabled system
+post_beam_load(_Mod, undefined) ->
+ ok;
+post_beam_load(Mod, _) when is_atom(Mod) ->
+ erlang:system_flag(multi_scheduling, block),
+ try
+ patch_to_emu(Mod)
+ after
+ erlang:system_flag(multi_scheduling, unblock)
+ end,
+ ok.
%%========================================================================
@@ -148,46 +147,48 @@ version_check(Version, Mod) when is_atom(Mod) ->
%%========================================================================
--spec load_module(Mod, binary(), _) -> 'bad_crc' | {'module', Mod}
- when Mod :: atom().
-load_module(Mod, Bin, Beam) ->
+-spec load_module(Mod, binary(), _, hipe_architecture()) ->
+ 'bad_crc' | {'module', Mod} when Mod :: atom().
+
+load_module(Mod, Bin, Beam, Architecture) ->
erlang:system_flag(multi_scheduling, block),
try
- load_module_nosmp(Mod, Bin, Beam)
+ load_module_nosmp(Mod, Bin, Beam, Architecture)
after
erlang:system_flag(multi_scheduling, unblock)
end.
-load_module_nosmp(Mod, Bin, Beam) ->
- load_module(Mod, Bin, Beam, []).
+load_module_nosmp(Mod, Bin, Beam, Architecture) ->
+ load_module(Mod, Bin, Beam, [], Architecture).
-load_module(Mod, Bin, Beam, OldReferencesToPatch) ->
+load_module(Mod, Bin, Beam, OldReferencesToPatch, Architecture) ->
?debug_msg("************ Loading Module ~w ************\n",[Mod]),
%% Loading a whole module, let the BEAM loader patch closures.
put(hipe_patch_closures, false),
- load_common(Mod, Bin, Beam, OldReferencesToPatch).
+ load_common(Mod, Bin, Beam, OldReferencesToPatch, Architecture).
%%========================================================================
--spec load(Mod, binary()) -> 'bad_crc' | {'module', Mod} when Mod :: atom().
+-spec load(Mod, binary(), hipe_architecture()) ->
+ 'bad_crc' | {'module', Mod} when Mod :: atom().
-load(Mod, Bin) ->
+load(Mod, Bin, Architecture) ->
erlang:system_flag(multi_scheduling, block),
try
- load_nosmp(Mod, Bin)
+ load_nosmp(Mod, Bin, Architecture)
after
erlang:system_flag(multi_scheduling, unblock)
end.
-load_nosmp(Mod, Bin) ->
+load_nosmp(Mod, Bin, Architecture) ->
?debug_msg("********* Loading funs in module ~w *********\n",[Mod]),
%% Loading just some functions in a module; patch closures separately.
put(hipe_patch_closures, true),
- load_common(Mod, Bin, [], []).
+ load_common(Mod, Bin, [], [], Architecture).
%%------------------------------------------------------------------------
-load_common(Mod, Bin, Beam, OldReferencesToPatch) ->
+load_common(Mod, Bin, Beam, OldReferencesToPatch, Architecture) ->
%% Unpack the binary.
[{Version, CheckSum},
ConstAlign, ConstSize, ConstMap, LabelMap, ExportMap,
@@ -212,18 +213,21 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) ->
bad_crc;
true ->
put(closures_to_patch, []),
+ WordSize = word_size(Architecture),
+ WriteWord = write_word_fun(WordSize),
%% Create data segment
{ConstAddr,ConstMap2} =
- create_data_segment(ConstAlign, ConstSize, ConstMap),
+ create_data_segment(ConstAlign, ConstSize, ConstMap, WriteWord),
%% Find callees for which we may need trampolines.
- CalleeMFAs = find_callee_mfas(Refs),
+ CalleeMFAs = find_callee_mfas(Refs, Architecture),
%% Write the code to memory.
{CodeAddress,Trampolines} =
enter_code(CodeSize, CodeBinary, CalleeMFAs, Mod, Beam),
%% Construct CalleeMFA-to-trampoline mapping.
- TrampolineMap = mk_trampoline_map(CalleeMFAs, Trampolines),
+ TrampolineMap = mk_trampoline_map(CalleeMFAs, Trampolines,
+ Architecture),
%% Patch references to code labels in data seg.
- ok = patch_consts(LabelMap, ConstAddr, CodeAddress),
+ ok = patch_consts(LabelMap, ConstAddr, CodeAddress, WriteWord),
%% Find out which functions are being loaded (and where).
%% Note: Addresses are sorted descending.
{MFAs,Addresses} = exports(ExportMap, CodeAddress),
@@ -275,14 +279,26 @@ load_common(Mod, Bin, Beam, OldReferencesToPatch) ->
%% Scan the list of patches and build a set (returned as a tuple)
%% of the callees for which we may need trampolines.
%%
-find_callee_mfas(Patches) when is_list(Patches) ->
- case erlang:system_info(hipe_architecture) of
- amd64 -> [];
- arm -> find_callee_mfas(Patches, gb_sets:empty(), false);
- powerpc -> find_callee_mfas(Patches, gb_sets:empty(), true);
- ppc64 -> find_callee_mfas(Patches, gb_sets:empty(), true);
- ultrasparc -> [];
- x86 -> []
+find_callee_mfas(Patches, Architecture) when is_list(Patches) ->
+ case needs_trampolines(Architecture) of
+ true -> find_callee_mfas(Patches, gb_sets:empty(),
+ no_erts_trampolines(Architecture));
+ _ -> []
+ end.
+
+needs_trampolines(Architecture) ->
+ case Architecture of
+ arm -> true;
+ powerpc -> true;
+ ppc64 -> true;
+ _ -> false
+ end.
+
+no_erts_trampolines(Architecture) ->
+ case Architecture of
+ powerpc -> true;
+ ppc64 -> true;
+ _ -> false
end.
find_callee_mfas([{Type,Data}|Patches], MFAs, SkipErtsSyms) ->
@@ -318,14 +334,9 @@ add_callee_mfas([], MFAs, _SkipErtsSyms) -> MFAs.
%%----------------------------------------------------------------
%%
-mk_trampoline_map([], []) -> []; % archs not using trampolines
-mk_trampoline_map(CalleeMFAs, Trampolines) ->
- SizeofLong =
- case erlang:system_info(hipe_architecture) of
- amd64 -> 8;
- ppc64 -> 8;
- _ -> 4
- end,
+mk_trampoline_map([], [], _) -> []; % archs not using trampolines
+mk_trampoline_map(CalleeMFAs, Trampolines, Architecture) ->
+ SizeofLong = word_size(Architecture),
mk_trampoline_map(tuple_size(CalleeMFAs), CalleeMFAs,
Trampolines, SizeofLong, gb_trees:empty()).
@@ -621,22 +632,24 @@ patch_load_mfa(CodeAddress, DestMFA, Addresses, RemoteOrLocal) ->
%%----------------------------------------------------------------
%% Patch references to code labels in the data segment.
%%
-patch_consts(Labels, DataAddress, CodeAddress) ->
+patch_consts(Labels, DataAddress, CodeAddress, WriteWord) ->
lists:foreach(fun (L) ->
- patch_label_or_labels(L, DataAddress, CodeAddress)
+ patch_label_or_labels(L, DataAddress, CodeAddress,
+ WriteWord)
end, Labels).
-patch_label_or_labels({Pos,Offset}, DataAddress, CodeAddress) ->
+patch_label_or_labels({Pos,Offset}, DataAddress, CodeAddress, WriteWord) ->
?ASSERT(assert_local_patch(CodeAddress+Offset)),
- write_word(DataAddress+Pos, CodeAddress+Offset);
-patch_label_or_labels({sorted,Base,UnOrderdList}, DataAddress, CodeAddress) ->
- sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress).
+ WriteWord(DataAddress+Pos, CodeAddress+Offset);
+patch_label_or_labels({sorted,Base,UnOrderdList}, DataAddress, CodeAddress,
+ WriteWord) ->
+ sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress, WriteWord).
-sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress) ->
+sort_and_write(UnOrderdList, Base, DataAddress, CodeAddress, WriteWord) ->
WriteAndInc =
fun ({_, Offset}, DataPos) ->
?ASSERT(assert_local_patch(CodeAddress+Offset)),
- write_word(DataPos, CodeAddress+Offset)
+ WriteWord(DataPos, CodeAddress+Offset)
end,
lists:foldl(WriteAndInc, DataAddress+Base, sort_on_representation(UnOrderdList)).
@@ -662,17 +675,18 @@ patch_instr(Address, Value, Type) ->
%% XXX: It appears this is used for inserting both code addresses
%% and other data. In HiPE, code addresses are still 32-bit on
%% some 64-bit machines.
-write_word(DataAddress, DataWord) ->
- case erlang:system_info(hipe_architecture) of
- amd64 ->
- hipe_bifs:write_u64(DataAddress, DataWord),
- DataAddress+8;
- ppc64 ->
- hipe_bifs:write_u64(DataAddress, DataWord),
- DataAddress+8;
- _ ->
- hipe_bifs:write_u32(DataAddress, DataWord),
- DataAddress+4
+write_word_fun(WordSize) ->
+ case WordSize of
+ 8 ->
+ fun (DataAddress, DataWord) ->
+ hipe_bifs:write_u64(DataAddress, DataWord),
+ DataAddress+8
+ end;
+ 4 ->
+ fun (DataAddress, DataWord) ->
+ hipe_bifs:write_u32(DataAddress, DataWord),
+ DataAddress+4
+ end
end.
%%--------------------------------------------------------------------
@@ -688,30 +702,31 @@ bif_address(Name) when is_atom(Name) ->
%% memory, and produces a ConstMap2 mapping each constant's ConstNo to
%% its runtime address, tagged if the constant is a term.
%%
-create_data_segment(DataAlign, DataSize, DataList) ->
+create_data_segment(DataAlign, DataSize, DataList, WriteWord) ->
%%io:format("create_data_segment: \nDataAlign: ~p\nDataSize: ~p\nDataList: ~p\n",[DataAlign,DataSize,DataList]),
DataAddress = hipe_bifs:alloc_data(DataAlign, DataSize),
- enter_data(DataList, [], DataAddress, DataSize).
+ enter_data(DataList, [], DataAddress, DataSize, WriteWord).
-enter_data(List, ConstMap2, DataAddress, DataSize) ->
+enter_data(List, ConstMap2, DataAddress, DataSize, WriteWord) ->
case List of
[ConstNo,Offset,Type,Data|Rest] when is_integer(Offset) ->
%%?msg("Const ~w\n",[[ConstNo,Offset,Type,Data]]),
?ASSERT((Offset >= 0) and (Offset =< DataSize)),
- Res = enter_datum(Type, Data, DataAddress+Offset),
- enter_data(Rest, [{ConstNo,Res}|ConstMap2], DataAddress, DataSize);
+ Res = enter_datum(Type, Data, DataAddress+Offset, WriteWord),
+ enter_data(Rest, [{ConstNo,Res}|ConstMap2], DataAddress, DataSize,
+ WriteWord);
[] ->
{DataAddress, ConstMap2}
end.
-enter_datum(Type, Data, Address) ->
+enter_datum(Type, Data, Address, WriteWord) ->
case ?EXT2CONST_TYPE(Type) of
term ->
%% Address is unused for terms
hipe_bifs:term_to_word(hipe_bifs:merge_term(Data));
sorted_block ->
L = lists:sort([hipe_bifs:term_to_word(Term) || Term <- Data]),
- write_words(L, Address),
+ write_words(L, Address, WriteWord),
Address;
block ->
case Data of
@@ -719,7 +734,7 @@ enter_datum(Type, Data, Address) ->
write_bytes(Lbls, Address);
{Lbls, SortOrder} ->
SortedLbls = [Lbl || {_,Lbl} <- lists:sort(group(Lbls, SortOrder))],
- write_words(SortedLbls, Address);
+ write_words(SortedLbls, Address, WriteWord);
Lbls ->
write_bytes(Lbls, Address)
end,
@@ -734,9 +749,9 @@ group([B1,B2,B3,B4|Ls], [O|Os]) ->
bytes_to_32(B4,B3,B2,B1) ->
(B4 bsl 24) bor (B3 bsl 16) bor (B2 bsl 8) bor B1.
-write_words([W|Rest], Addr) ->
- write_words(Rest, write_word(Addr, W));
-write_words([], Addr) when is_integer(Addr) -> true.
+write_words([W|Rest], Addr, WriteWord) ->
+ write_words(Rest, WriteWord(Addr, W), WriteWord);
+write_words([], Addr, _) when is_integer(Addr) -> true.
write_bytes([B|Rest], Addr) ->
hipe_bifs:write_u8(Addr, B),
@@ -812,7 +827,7 @@ address_to_mfa_lth(_Address, [], Prev) ->
%%----------------------------------------------------------------
%% Change callers of the given module to instead trap to BEAM.
-%% load_native_code/2 calls this just before loading native code.
+%% load_native_code/3 calls this just before loading native code.
%%
patch_to_emu(Mod) ->
patch_to_emu_step2(patch_to_emu_step1(Mod)).
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index c82aaf0582..be55e25811 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -810,14 +810,6 @@ check_funs({'$M_EXPR','$F_EXPR',_},
{unicode,characters_to_binary,3},
{filename,filename_string_to_binary,1}|_]) -> 0;
check_funs({'$M_EXPR','$F_EXPR',_},
- [{code_server,load_native_code,4},
- {code_server,load_native_code_1,2},
- {code_server,load_native_code,2},
- {code_server,try_load_module,4},
- {code_server,do_load_binary,4},
- {code_server,handle_call,3},
- {code_server,loop,1}|_]) -> 0;
-check_funs({'$M_EXPR','$F_EXPR',_},
[{code_server,do_mod_call,4},
{code_server,handle_call,3}|_]) -> 0;
check_funs({'$M_EXPR','$F_EXPR',_},
@@ -866,8 +858,14 @@ check_funs({'$M_EXPR','$F_EXPR',_},
check_funs({'$M_EXPR',module_info,1},
[{hipe_unified_loader,patch_to_emu_step1,1} | _]) -> 0;
check_funs({'$M_EXPR','$F_EXPR',2},
+ [{hipe_unified_loader,write_words,3} | _]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',2},
+ [{hipe_unified_loader,patch_label_or_labels,4} | _]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',2},
+ [{hipe_unified_loader,sort_and_write,5} | _]) -> 0;
+check_funs({'$M_EXPR','$F_EXPR',2},
[{lists,foldl,3},
- {hipe_unified_loader,sort_and_write,4} | _]) -> 0;
+ {hipe_unified_loader,sort_and_write,5} | _]) -> 0;
check_funs({'$M_EXPR','$F_EXPR',1},
[{lists,foreach,2},
{hipe_unified_loader,patch_consts,3} | _]) -> 0;
diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl
index 4f0d7a7d50..76a9708a58 100644
--- a/lib/kernel/test/gen_tcp_misc_SUITE.erl
+++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl
@@ -38,7 +38,9 @@
% Accept tests
primitive_accept/1,multi_accept_close_listen/1,accept_timeout/1,
accept_timeouts_in_order/1,accept_timeouts_in_order2/1,
- accept_timeouts_in_order3/1,accept_timeouts_mixed/1,
+ accept_timeouts_in_order3/1,accept_timeouts_in_order4/1,
+ accept_timeouts_in_order5/1,accept_timeouts_in_order6/1,
+ accept_timeouts_in_order7/1,accept_timeouts_mixed/1,
killing_acceptor/1,killing_multi_acceptors/1,killing_multi_acceptors2/1,
several_accepts_in_one_go/1, accept_system_limit/1,
active_once_closed/1, send_timeout/1, send_timeout_active/1,
@@ -99,7 +101,9 @@ all() ->
so_priority, primitive_accept,
multi_accept_close_listen, accept_timeout,
accept_timeouts_in_order, accept_timeouts_in_order2,
- accept_timeouts_in_order3, accept_timeouts_mixed,
+ accept_timeouts_in_order3, accept_timeouts_in_order4,
+ accept_timeouts_in_order5, accept_timeouts_in_order6,
+ accept_timeouts_in_order7, accept_timeouts_mixed,
killing_acceptor, killing_multi_acceptors,
killing_multi_acceptors2, several_accepts_in_one_go, accept_system_limit,
active_once_closed, send_timeout, send_timeout_active, otp_7731,
@@ -1720,8 +1724,8 @@ multi_accept_close_listen(Config) when is_list(Config) ->
spawn(F),
spawn(F),
gen_tcp:close(LS),
- ?EXPECT_ACCEPTS([{_,{error,closed}},{_,{error,closed}},
- {_,{error,closed}},{_,{error,closed}}],4,500).
+ ok = ?EXPECT_ACCEPTS([{_,{error,closed}},{_,{error,closed}},
+ {_,{error,closed}},{_,{error,closed}}],4,500).
accept_timeout(suite) ->
[];
@@ -1732,7 +1736,7 @@ accept_timeout(Config) when is_list(Config) ->
Parent = self(),
F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS,1000)} end,
P = spawn(F),
- ?EXPECT_ACCEPTS([{P,{error,timeout}}],1,2000).
+ ok = ?EXPECT_ACCEPTS([{P,{error,timeout}}],1,2000).
accept_timeouts_in_order(suite) ->
[];
@@ -1745,8 +1749,8 @@ accept_timeouts_in_order(Config) when is_list(Config) ->
P2 = spawn(mktmofun(1200,Parent,LS)),
P3 = spawn(mktmofun(1300,Parent,LS)),
P4 = spawn(mktmofun(1400,Parent,LS)),
- ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}},
- {P3,{error,timeout}},{P4,{error,timeout}}],infinity,2000).
+ ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}},
+ {P3,{error,timeout}},{P4,{error,timeout}}],infinity,2000).
accept_timeouts_in_order2(suite) ->
[];
@@ -1759,8 +1763,8 @@ accept_timeouts_in_order2(Config) when is_list(Config) ->
P2 = spawn(mktmofun(1300,Parent,LS)),
P3 = spawn(mktmofun(1200,Parent,LS)),
P4 = spawn(mktmofun(1000,Parent,LS)),
- ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P3,{error,timeout}},
- {P2,{error,timeout}},{P1,{error,timeout}}],infinity,2000).
+ ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P3,{error,timeout}},
+ {P2,{error,timeout}},{P1,{error,timeout}}],infinity,2000).
accept_timeouts_in_order3(suite) ->
[];
@@ -1773,8 +1777,74 @@ accept_timeouts_in_order3(Config) when is_list(Config) ->
P2 = spawn(mktmofun(1400,Parent,LS)),
P3 = spawn(mktmofun(1300,Parent,LS)),
P4 = spawn(mktmofun(1000,Parent,LS)),
- ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}},
- {P3,{error,timeout}},{P2,{error,timeout}}],infinity,2000).
+ ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}},
+ {P3,{error,timeout}},{P2,{error,timeout}}],infinity,2000).
+
+accept_timeouts_in_order4(suite) ->
+ [];
+accept_timeouts_in_order4(doc) ->
+ ["Check that multi-accept timeouts happen in the correct order after "
+ "mixing millsec and sec timeouts"];
+accept_timeouts_in_order4(Config) when is_list(Config) ->
+ {ok,LS}=gen_tcp:listen(0,[]),
+ Parent = self(),
+ P1 = spawn(mktmofun(200,Parent,LS)),
+ P2 = spawn(mktmofun(400,Parent,LS)),
+ P3 = spawn(mktmofun(1000,Parent,LS)),
+ P4 = spawn(mktmofun(600,Parent,LS)),
+ ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}},
+ {P4,{error,timeout}},{P3,{error,timeout}}],infinity,2000).
+
+accept_timeouts_in_order5(suite) ->
+ [];
+accept_timeouts_in_order5(doc) ->
+ ["Check that multi-accept timeouts happen in the correct order after "
+ "mixing millsec and sec timeouts (more)"];
+accept_timeouts_in_order5(Config) when is_list(Config) ->
+ {ok,LS}=gen_tcp:listen(0,[]),
+ Parent = self(),
+ P1 = spawn(mktmofun(400,Parent,LS)),
+ P2 = spawn(mktmofun(1000,Parent,LS)),
+ P3 = spawn(mktmofun(600,Parent,LS)),
+ P4 = spawn(mktmofun(200,Parent,LS)),
+ ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}},
+ {P3,{error,timeout}},{P2,{error,timeout}}],infinity,2000).
+
+accept_timeouts_in_order6(suite) ->
+ [];
+accept_timeouts_in_order6(doc) ->
+ ["Check that multi-accept timeouts happen in the correct order after "
+ "mixing millsec and sec timeouts (even more)"];
+accept_timeouts_in_order6(Config) when is_list(Config) ->
+ {ok,LS}=gen_tcp:listen(0,[]),
+ Parent = self(),
+ P1 = spawn(mktmofun(1000,Parent,LS)),
+ P2 = spawn(mktmofun(400,Parent,LS)),
+ P3 = spawn(mktmofun(600,Parent,LS)),
+ P4 = spawn(mktmofun(200,Parent,LS)),
+ ok = ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P2,{error,timeout}},
+ {P3,{error,timeout}},{P1,{error,timeout}}],infinity,2000).
+
+accept_timeouts_in_order7(suite) ->
+ [];
+accept_timeouts_in_order7(doc) ->
+ ["Check that multi-accept timeouts happen in the correct order after "
+ "mixing millsec and sec timeouts (even more++)"];
+accept_timeouts_in_order7(Config) when is_list(Config) ->
+ {ok,LS}=gen_tcp:listen(0,[]),
+ Parent = self(),
+ P1 = spawn(mktmofun(1000,Parent,LS)),
+ P2 = spawn(mktmofun(200,Parent,LS)),
+ P3 = spawn(mktmofun(1200,Parent,LS)),
+ P4 = spawn(mktmofun(600,Parent,LS)),
+ P5 = spawn(mktmofun(400,Parent,LS)),
+ P6 = spawn(mktmofun(800,Parent,LS)),
+ P7 = spawn(mktmofun(1600,Parent,LS)),
+ P8 = spawn(mktmofun(1400,Parent,LS)),
+ ok = ?EXPECT_ACCEPTS([{P2,{error,timeout}},{P5,{error,timeout}},
+ {P4,{error,timeout}},{P6,{error,timeout}},
+ {P1,{error,timeout}},{P3,{error,timeout}},
+ {P8,{error,timeout}},{P7,{error,timeout}}],infinity,2000).
accept_timeouts_mixed(suite) ->
[];
@@ -1797,7 +1867,7 @@ accept_timeouts_mixed(Config) when is_list(Config) ->
ok = ?EXPECT_ACCEPTS([{P2,{ok,Port0}}] when is_port(Port0),infinity,100),
ok = ?EXPECT_ACCEPTS([{P3,{error,timeout}}],infinity,2000),
gen_tcp:connect("localhost",PortNo,[]),
- ?EXPECT_ACCEPTS([{P4,{ok,Port1}}] when is_port(Port1),infinity,100).
+ ok = ?EXPECT_ACCEPTS([{P4,{ok,Port1}}] when is_port(Port1),infinity,100).
killing_acceptor(suite) ->
[];
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index 18d98e5efb..9122066787 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -650,6 +650,27 @@ fun(srp, Username :: string(), UserState :: term()) ->
The option <c>sni_fun</c>, and <c>sni_hosts</c> are mutually exclusive.</p></item>
+ <tag><c>{client_renegotiation, boolean()}</c></tag>
+ <item>In protocols that support client-initiated renegotiation, the cost
+ of resources of such an operation is higher for the server than the
+ client. This can act as a vector for denial of service attacks. The SSL
+ application already takes measures to counter-act such attempts,
+ but client-initiated renegotiation can be stricly disabled by setting
+ this option to <c>false</c>. The default value is <c>true</c>.
+ Note that disabling renegotiation can result in long-lived connections
+ becoming unusable due to limits on the number of messages the underlying
+ cipher suite can encipher.
+ </item>
+
+ <tag><c>{psk_identity, string()}</c></tag>
+ <item>Specifies the server identity hint the server presents to the client.
+ </item>
+ <tag><c>{log_alert, boolean()}</c></tag>
+ <item>If false, error reports will not be displayed.</item>
+ <tag><c>{honor_cipher_order, boolean()}</c></tag>
+ <item>If true, use the server's preference for cipher selection. If false
+ (the default), use the client's preference.
+ </item>
</taglist>
</section>
diff --git a/lib/ssl/src/dtls_connection.erl b/lib/ssl/src/dtls_connection.erl
index 610e2c4e41..0c73a49a04 100644
--- a/lib/ssl/src/dtls_connection.erl
+++ b/lib/ssl/src/dtls_connection.erl
@@ -514,6 +514,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions}, User,
user_data_buffer = <<>>,
session_cache_cb = SessionCacheCb,
renegotiation = {false, first},
+ allow_renegotiate = SSLOptions#ssl_options.client_renegotiation,
start_or_recv_from = undefined,
send_queue = queue:new(),
protocol_cb = ?MODULE
diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src
index d100e41930..1476336039 100644
--- a/lib/ssl/src/ssl.appup.src
+++ b/lib/ssl/src/ssl.appup.src
@@ -1,16 +1,14 @@
%% -*- erlang -*-
{"%VSN%",
[
- {<<"6.0">>, [{load_module, ssl_handshake, soft_purge, soft_purge, []}]},
- {<<"5\\.3\\.[1-7]($|\\..*)">>, [{restart_application, ssl}]},
- {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]},
+ {<<"6\\..*">>, [{restart_application, ssl}]},
+ {<<"5\\..*">>, [{restart_application, ssl}]},
{<<"4\\..*">>, [{restart_application, ssl}]},
{<<"3\\..*">>, [{restart_application, ssl}]}
],
[
- {<<"6.0">>, [{load_module, ssl_handshake, soft_purge, soft_purge, []}]},
- {<<"5\\.3\\.[1-7]($|\\..*)">>, [{restart_application, ssl}]},
- {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]},
+ {<<"6\\..*">>, [{restart_application, ssl}]},
+ {<<"5\\..*">>, [{restart_application, ssl}]},
{<<"4\\..*">>, [{restart_application, ssl}]},
{<<"3\\..*">>, [{restart_application, ssl}]}
]
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index 225a9be66f..f8ddfba7e3 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -685,6 +685,7 @@ handle_options(Opts0) ->
reuse_session = handle_option(reuse_session, Opts, ReuseSessionFun),
reuse_sessions = handle_option(reuse_sessions, Opts, true),
secure_renegotiate = handle_option(secure_renegotiate, Opts, false),
+ client_renegotiation = handle_option(client_renegotiation, Opts, true),
renegotiate_at = handle_option(renegotiate_at, Opts, ?DEFAULT_RENEGOTIATE_AT),
hibernate_after = handle_option(hibernate_after, Opts, undefined),
erl_dist = handle_option(erl_dist, Opts, false),
@@ -715,7 +716,7 @@ handle_options(Opts0) ->
depth, cert, certfile, key, keyfile,
password, cacerts, cacertfile, dh, dhfile,
user_lookup_fun, psk_identity, srp_identity, ciphers,
- reuse_session, reuse_sessions, ssl_imp,
+ reuse_session, reuse_sessions, ssl_imp, client_renegotiation,
cb_info, renegotiate_at, secure_renegotiate, hibernate_after,
erl_dist, alpn_advertised_protocols, sni_hosts, sni_fun,
alpn_preferred_protocols, next_protocols_advertised,
@@ -857,6 +858,8 @@ validate_option(reuse_sessions, Value) when is_boolean(Value) ->
validate_option(secure_renegotiate, Value) when is_boolean(Value) ->
Value;
+validate_option(client_renegotiation, Value) when is_boolean(Value) ->
+ Value;
validate_option(renegotiate_at, Value) when is_integer(Value) ->
erlang:min(Value, ?DEFAULT_RENEGOTIATE_AT);
@@ -1226,6 +1229,8 @@ new_ssl_options([{renegotiate_at, Value} | Rest], #ssl_options{} = Opts, RecordC
new_ssl_options(Rest, Opts#ssl_options{ renegotiate_at = validate_option(renegotiate_at, Value)}, RecordCB);
new_ssl_options([{secure_renegotiate, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
new_ssl_options(Rest, Opts#ssl_options{secure_renegotiate = validate_option(secure_renegotiate, Value)}, RecordCB);
+new_ssl_options([{client_renegotiation, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
+ new_ssl_options(Rest, Opts#ssl_options{client_renegotiation = validate_option(client_renegotiation, Value)}, RecordCB);
new_ssl_options([{hibernate_after, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
new_ssl_options(Rest, Opts#ssl_options{hibernate_after = validate_option(hibernate_after, Value)}, RecordCB);
new_ssl_options([{alpn_advertised_protocols, Value} | Rest], #ssl_options{} = Opts, RecordCB) ->
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index baeae68bc4..40eb3d0284 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -110,6 +110,7 @@
reuse_sessions :: boolean(),
renegotiate_at,
secure_renegotiate,
+ client_renegotiation,
%% undefined if not hibernating, or number of ms of
%% inactivity after which ssl_connection will go into
%% hibernation
diff --git a/lib/ssl/src/tls_connection.erl b/lib/ssl/src/tls_connection.erl
index 3304ffcddb..ed7ccb3d70 100644
--- a/lib/ssl/src/tls_connection.erl
+++ b/lib/ssl/src/tls_connection.erl
@@ -392,6 +392,7 @@ initial_state(Role, Host, Port, Socket, {SSLOptions, SocketOptions, Tracker}, Us
user_data_buffer = <<>>,
session_cache_cb = SessionCacheCb,
renegotiation = {false, first},
+ allow_renegotiate = SSLOptions#ssl_options.client_renegotiation,
start_or_recv_from = undefined,
send_queue = queue:new(),
protocol_cb = ?MODULE,
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index e1a36dbbd4..e131c363d1 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -162,7 +162,8 @@ renegotiate_tests() ->
client_no_wrap_sequence_number,
server_no_wrap_sequence_number,
renegotiate_dos_mitigate_active,
- renegotiate_dos_mitigate_passive].
+ renegotiate_dos_mitigate_passive,
+ renegotiate_dos_mitigate_absolute].
cipher_tests() ->
[cipher_suites,
@@ -2998,8 +2999,36 @@ renegotiate_dos_mitigate_passive(Config) when is_list(Config) ->
ssl_test_lib:close(Client).
%%--------------------------------------------------------------------
+renegotiate_dos_mitigate_absolute() ->
+ [{doc, "Mitigate DOS computational attack by not allowing client to initiate renegotiation"}].
+renegotiate_dos_mitigate_absolute(Config) when is_list(Config) ->
+ ServerOpts = ?config(server_opts, Config),
+ ClientOpts = ?config(client_opts, Config),
+
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+
+ Server =
+ ssl_test_lib:start_server([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {mfa, {ssl_test_lib, send_recv_result_active, []}},
+ {options, [{client_renegotiation, false} | ServerOpts]}]),
+ Port = ssl_test_lib:inet_port(Server),
+
+ Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {mfa, {?MODULE,
+ renegotiate_rejected,
+ []}},
+ {options, ClientOpts}]),
+
+ ssl_test_lib:check_result(Client, ok, Server, ok),
+ ssl_test_lib:close(Server),
+ ssl_test_lib:close(Client).
+
+%%--------------------------------------------------------------------
tcp_error_propagation_in_active_mode() ->
- [{doc,"Test that process recives {ssl_error, Socket, closed} when tcp error ocurres"}].
+ [{doc,"Test that process recives {ssl_error, Socket, closed} when tcp error occurs"}].
tcp_error_propagation_in_active_mode(Config) when is_list(Config) ->
ClientOpts = ?config(client_opts, Config),
ServerOpts = ?config(server_opts, Config),
@@ -3433,12 +3462,12 @@ renegotiate_reuse_session(Socket, Data) ->
renegotiate(Socket, Data).
renegotiate_immediately(Socket) ->
- receive
+ receive
{ssl, Socket, "Hello world"} ->
ok;
%% Handle 1/n-1 splitting countermeasure Rizzo/Duong-Beast
{ssl, Socket, "H"} ->
- receive
+ receive
{ssl, Socket, "ello world"} ->
ok
end
@@ -3450,6 +3479,26 @@ renegotiate_immediately(Socket) ->
ct:log("Renegotiated again"),
ssl:send(Socket, "Hello world"),
ok.
+
+renegotiate_rejected(Socket) ->
+ receive
+ {ssl, Socket, "Hello world"} ->
+ ok;
+ %% Handle 1/n-1 splitting countermeasure Rizzo/Duong-Beast
+ {ssl, Socket, "H"} ->
+ receive
+ {ssl, Socket, "ello world"} ->
+ ok
+ end
+ end,
+ {error, renegotiation_rejected} = ssl:renegotiate(Socket),
+ {error, renegotiation_rejected} = ssl:renegotiate(Socket),
+ ct:sleep(?RENEGOTIATION_DISABLE_TIME +1),
+ {error, renegotiation_rejected} = ssl:renegotiate(Socket),
+ ct:log("Failed to renegotiate again"),
+ ssl:send(Socket, "Hello world"),
+ ok.
+
new_config(PrivDir, ServerOpts0) ->
CaCertFile = proplists:get_value(cacertfile, ServerOpts0),
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index aca34cb6e9..21ce4c4a29 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -1036,7 +1036,7 @@ erlang_client_openssl_server_alpn(Config) when is_list(Config) ->
erlang_server_alpn_openssl_client(Config) when is_list(Config) ->
Data = "From openssl to erlang",
start_erlang_server_and_openssl_client_with_opts(Config,
- [{alpn_advertised_protocols, [<<"spdy/2">>]}],
+ [{alpn_preferred_protocols, [<<"spdy/2">>]}],
"",
Data, fun(Server, OpensslPort) ->
true = port_command(OpensslPort, Data),
diff --git a/lib/stdlib/doc/src/Makefile b/lib/stdlib/doc/src/Makefile
index a4a2ed9931..d41f91250e 100644
--- a/lib/stdlib/doc/src/Makefile
+++ b/lib/stdlib/doc/src/Makefile
@@ -102,7 +102,7 @@ XML_REF3_FILES = \
XML_REF6_FILES = stdlib_app.xml
XML_PART_FILES = part.xml part_notes.xml part_notes_history.xml
-XML_CHAPTER_FILES = io_protocol.xml unicode_usage.xml notes.xml notes_history.xml
+XML_CHAPTER_FILES = io_protocol.xml unicode_usage.xml notes.xml notes_history.xml assert_hrl.xml
BOOK_FILES = book.xml
diff --git a/lib/stdlib/doc/src/assert_hrl.xml b/lib/stdlib/doc/src/assert_hrl.xml
new file mode 100644
index 0000000000..d812ee16dc
--- /dev/null
+++ b/lib/stdlib/doc/src/assert_hrl.xml
@@ -0,0 +1,160 @@
+<?xml version="1.0" encoding="utf-8" ?>
+<!DOCTYPE fileref SYSTEM "fileref.dtd">
+
+<fileref>
+ <header>
+ <copyright>
+ <year>2012</year><year>2015</year>
+ <holder>Ericsson AB. All Rights Reserved.</holder>
+ </copyright>
+ <legalnotice>
+ The contents of this file are subject to the Erlang Public License,
+ Version 1.1, (the "License"); you may not use this file except in
+ compliance with the License. You should have received a copy of the
+ Erlang Public License along with this software. If not, it can be
+ retrieved online at http://www.erlang.org/.
+
+ Software distributed under the License is distributed on an "AS IS"
+ basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+ the License for the specific language governing rights and limitations
+ under the License.
+
+ </legalnotice>
+
+ <title>assert.hrl</title>
+ <prepared></prepared>
+ <docno></docno>
+ <date></date>
+ <rev></rev>
+ </header>
+ <file>assert.hrl</file>
+ <filesummary>Assert Macros</filesummary>
+ <description>
+ <p>The include file <c>assert.hrl</c> provides macros for inserting
+ assertions in your program code.</p>
+ <p>These macros are defined in the Stdlib include file
+ <c>assert.hrl</c>. Include the following directive in the module
+ from which the function is called:</p>
+ <code type="none">
+-include_lib("stdlib/include/assert.hrl").</code>
+ <p>When an assertion succeeds, the assert macro yields the atom
+ <c>ok</c>. When an assertion fails, an exception of type <c>error</c> is
+ instead generated. The associated error term will have the form
+ <c>{Macro, Info}</c>, where <c>Macro</c> is the name of the macro, for
+ example <c>assertEqual</c>, and <c>Info</c> will be a list of tagged
+ values such as <c>[{module, M}, {line, L}, ...]</c> giving more
+ information about the location and cause of the exception. All entries
+ in the <c>Info</c> list are optional, and you should not rely
+ programatically on any of them being present.</p>
+
+ <p>If the macro <c>NOASSERT</c> is defined when the <c>assert.hrl</c>
+ include file is read by the compiler, the macros will be defined as
+ equivalent to the atom <c>ok</c>. The test will not be performed, and
+ there will be no cost at runtime.</p>
+
+ <p>For example, using <c>erlc</c> to compile your modules, the following
+ will disable all assertions:</p>
+ <code type="none">
+erlc -DNOASSERT=true *.erl</code>
+ <p>(The value of <c>NOASSERT</c> does not matter, only the fact that it
+ is defined.)</p>
+ <p>A few other macros also have effect on the enabling or disabling of
+ assertions:</p>
+ <list type="bulleted">
+ <item>If <c>NODEBUG</c> is defined, it implies <c>NOASSERT</c>, unless
+ <c>DEBUG</c> is also defined, which is assumed to take
+ precedence.</item>
+ <item>If <c>ASSERT</c> is defined, it overrides <c>NOASSERT</c>, that
+ is, the assertions will remain enabled.</item>
+ </list>
+ <p>If you prefer, you can thus use only <c>DEBUG</c>/<c>NODEBUG</c> as
+ the main flags to control the behaviour of the assertions (which is
+ useful if you have other compiler conditionals or debugging macros
+ controlled by those flags), or you can use <c>ASSERT</c>/<c>NOASSERT</c>
+ to control only the assert macros.</p>
+
+ </description>
+
+ <section>
+ </section>
+
+ <section>
+ <title>Macros</title>
+ <taglist>
+ <tag><c>assert(BoolExpr)</c></tag>
+ <item><p>Tests that <c>BoolExpr</c> completes normally returning
+ <c>true</c>.</p>
+ </item>
+
+ <tag><c>assertNot(BoolExpr)</c></tag>
+ <item><p>Tests that <c>BoolExpr</c> completes normally returning
+ <c>false</c>.</p>
+ </item>
+
+ <tag><c>assertMatch(GuardedPattern, Expr)</c></tag>
+ <item><p>Tests that <c>Expr</c> completes normally yielding a value
+ that matches <c>GuardedPattern</c>. For example:
+ <code type="none">
+ ?assertMatch({bork, _}, f())</code></p>
+ <p>Note that a guard <c>when ...</c> can be included:
+ <code type="none">
+ ?assertMatch({bork, X} when X > 0, f())</code></p>
+ </item>
+
+ <tag><c>assertNotMatch(GuardedPattern, Expr)</c></tag>
+ <item><p>Tests that <c>Expr</c> completes normally yielding a value
+ that does not match <c>GuardedPattern</c>.</p>
+ <p>As in <c>assertMatch</c>, <c>GuardedPattern</c> can have a
+ <c>when</c> part.</p>
+ </item>
+
+ <tag><c>assertEqual(ExpectedValue, Expr)</c></tag>
+ <item><p>Tests that <c>Expr</c> completes normally yielding a value
+ that is exactly equal to <c>ExpectedValue</c>.</p>
+ </item>
+
+ <tag><c>assertNotEqual(ExpectedValue, Expr)</c></tag>
+ <item><p>Tests that <c>Expr</c> completes normally yielding a value
+ that is not exactly equal to <c>ExpectedValue</c>.</p>
+ </item>
+
+ <tag><c>assertException(Class, Term, Expr)</c></tag>
+ <item><p>Tests that <c>Expr</c> completes abnormally with an exception
+ of type <c>Class</c> and with the associated <c>Term</c>. The
+ assertion fails if <c>Expr</c> raises a different exception or if it
+ completes normally returning any value.</p>
+ <p>Note that both <c>Class</c> and <c>Term</c> can be guarded
+ patterns, as in <c>assertMatch</c>.</p>
+ </item>
+
+ <tag><c>assertNotException(Class, Term, Expr)</c></tag>
+ <item><p>Tests that <c>Expr</c> does not evaluate abnormally with an
+ exception of type <c>Class</c> and with the associated <c>Term</c>.
+ The assertion succeeds if <c>Expr</c> raises a different exception or
+ if it completes normally returning any value.</p>
+ <p>As in <c>assertException</c>, both <c>Class</c> and <c>Term</c>
+ can be guarded patterns.</p>
+ </item>
+
+ <tag><c>assertError(Term, Expr)</c></tag>
+ <item><p>Equivalent to <c>assertException(error, Term,
+ Expr)</c></p>
+ </item>
+
+ <tag><c>assertExit(Term, Expr)</c></tag>
+ <item><p>Equivalent to <c>assertException(exit, Term, Expr)</c></p>
+ </item>
+
+ <tag><c>assertThrow(Term, Expr)</c></tag>
+ <item><p>Equivalent to <c>assertException(throw, Term, Expr)</c></p>
+ </item>
+
+ </taglist>
+ </section>
+
+ <section>
+ <title>SEE ALSO</title>
+ <p><seealso marker="compiler:compile">compile(3)</seealso></p>
+ <p><seealso marker="erts:erlc">erlc(3)</seealso></p>
+ </section>
+</fileref>
diff --git a/lib/stdlib/doc/src/ref_man.xml b/lib/stdlib/doc/src/ref_man.xml
index eee4a68ca1..cae62612aa 100644
--- a/lib/stdlib/doc/src/ref_man.xml
+++ b/lib/stdlib/doc/src/ref_man.xml
@@ -35,6 +35,7 @@
</description>
<xi:include href="stdlib_app.xml"/>
<xi:include href="array.xml"/>
+ <xi:include href="assert_hrl.xml"/>
<xi:include href="base64.xml"/>
<xi:include href="beam_lib.xml"/>
<xi:include href="binary.xml"/>
diff --git a/lib/stdlib/include/assert.hrl b/lib/stdlib/include/assert.hrl
new file mode 100644
index 0000000000..239d19a6dc
--- /dev/null
+++ b/lib/stdlib/include/assert.hrl
@@ -0,0 +1,260 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright (C) 2004-2014 Richard Carlsson, Mickaël Rémond
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-ifndef(ASSERT_HRL).
+-define(ASSERT_HRL, true).
+
+%% Asserts are enabled unless NOASSERT is defined, and ASSERT can be used to
+%% override it: if both ASSERT and NOASSERT are defined, then ASSERT takes
+%% precedence, and NOASSERT will become undefined.
+%%
+%% Furthermore, if NODEBUG is defined, it implies NOASSERT, unless DEBUG or
+%% ASSERT are defined.
+%%
+%% If asserts are disabled, all assert macros are defined to be the atom
+%% 'ok'. If asserts are enabled, all assert macros are defined to yield 'ok'
+%% as the result if the test succeeds, and raise an error exception if the
+%% test fails. The error term will then have the form {Name, Info} where
+%% Name is the name of the macro and Info is a list of tagged tuples.
+
+%% allow NODEBUG to imply NOASSERT, unless DEBUG
+-ifdef(NODEBUG).
+-ifndef(DEBUG).
+-ifndef(NOASSERT).
+-define(NOASSERT, true).
+-endif.
+-endif.
+-endif.
+
+%% allow ASSERT to override NOASSERT
+-ifdef(ASSERT).
+-undef(NOASSERT).
+-endif.
+
+%% Assert macros must not depend on any non-kernel or stdlib libraries.
+%%
+%% We must use fun-call wrappers ((fun () -> ... end)()) to avoid
+%% exporting local variables, and furthermore we only use variable names
+%% prefixed with "__", that hopefully will not be bound outside the fun.
+%% It is not possible to nest assert macros.
+
+-ifdef(NOASSERT).
+-define(assert(BoolExpr),ok).
+-else.
+%% The assert macro is written the way it is so as not to cause warnings
+%% for clauses that cannot match, even if the expression is a constant.
+-define(assert(BoolExpr),
+ begin
+ ((fun () ->
+ case (BoolExpr) of
+ true -> ok;
+ __V -> erlang:error({assert,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??BoolExpr)},
+ {expected, true},
+ case __V of false -> {value, __V};
+ _ -> {not_boolean,__V}
+ end]})
+ end
+ end)())
+ end).
+-endif.
+
+%% This is the inverse case of assert, for convenience.
+-ifdef(NOASSERT).
+-define(assertNot(BoolExpr),ok).
+-else.
+-define(assertNot(BoolExpr),
+ begin
+ ((fun () ->
+ case (BoolExpr) of
+ false -> ok;
+ __V -> erlang:error({assert,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??BoolExpr)},
+ {expected, false},
+ case __V of true -> {value, __V};
+ _ -> {not_boolean,__V}
+ end]})
+ end
+ end)())
+ end).
+-endif.
+
+%% This is mostly a convenience which gives more detailed reports.
+%% Note: Guard is a guarded pattern, and can not be used for value.
+-ifdef(NOASSERT).
+-define(assertMatch(Guard, Expr), ok).
+-else.
+-define(assertMatch(Guard, Expr),
+ begin
+ ((fun () ->
+ case (Expr) of
+ Guard -> ok;
+ __V -> erlang:error({assertMatch,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {pattern, (??Guard)},
+ {value, __V}]})
+ end
+ end)())
+ end).
+-endif.
+
+%% This is the inverse case of assertMatch, for convenience.
+-ifdef(NOASSERT).
+-define(assertNotMatch(Guard, Expr), ok).
+-else.
+-define(assertNotMatch(Guard, Expr),
+ begin
+ ((fun () ->
+ __V = (Expr),
+ case __V of
+ Guard -> erlang:error({assertNotMatch,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {pattern, (??Guard)},
+ {value, __V}]});
+ _ -> ok
+ end
+ end)())
+ end).
+-endif.
+
+%% This is a convenience macro which gives more detailed reports when
+%% the expected LHS value is not a pattern, but a computed value
+-ifdef(NOASSERT).
+-define(assertEqual(Expect, Expr), ok).
+-else.
+-define(assertEqual(Expect, Expr),
+ begin
+ ((fun (__X) ->
+ case (Expr) of
+ __X -> ok;
+ __V -> erlang:error({assertEqual,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {expected, __X},
+ {value, __V}]})
+ end
+ end)(Expect))
+ end).
+-endif.
+
+%% This is the inverse case of assertEqual, for convenience.
+-ifdef(NOASSERT).
+-define(assertNotEqual(Unexpected, Expr), ok).
+-else.
+-define(assertNotEqual(Unexpected, Expr),
+ begin
+ ((fun (__X) ->
+ case (Expr) of
+ __X -> erlang:error({assertNotEqual,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {value, __X}]});
+ _ -> ok
+ end
+ end)(Unexpected))
+ end).
+-endif.
+
+%% Note: Class and Term are patterns, and can not be used for value.
+%% Term can be a guarded pattern, but Class cannot.
+-ifdef(NOASSERT).
+-define(assertException(Class, Term, Expr), ok).
+-else.
+-define(assertException(Class, Term, Expr),
+ begin
+ ((fun () ->
+ try (Expr) of
+ __V -> erlang:error({assertException,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {pattern,
+ "{ "++(??Class)++" , "++(??Term)
+ ++" , [...] }"},
+ {unexpected_success, __V}]})
+ catch
+ Class:Term -> ok;
+ __C:__T ->
+ erlang:error({assertException,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {pattern,
+ "{ "++(??Class)++" , "++(??Term)
+ ++" , [...] }"},
+ {unexpected_exception,
+ {__C, __T,
+ erlang:get_stacktrace()}}]})
+ end
+ end)())
+ end).
+-endif.
+
+-define(assertError(Term, Expr), ?assertException(error, Term, Expr)).
+-define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)).
+-define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)).
+
+%% This is the inverse case of assertException, for convenience.
+%% Note: Class and Term are patterns, and can not be used for value.
+%% Both Class and Term can be guarded patterns.
+-ifdef(NOASSERT).
+-define(assertNotException(Class, Term, Expr), ok).
+-else.
+-define(assertNotException(Class, Term, Expr),
+ begin
+ ((fun () ->
+ try (Expr) of
+ _ -> ok
+ catch
+ __C:__T ->
+ case __C of
+ Class ->
+ case __T of
+ Term ->
+ erlang:error({assertNotException,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {expression, (??Expr)},
+ {pattern,
+ "{ "++(??Class)++" , "
+ ++(??Term)++" , [...] }"},
+ {unexpected_exception,
+ {__C, __T,
+ erlang:get_stacktrace()
+ }}]});
+ _ -> ok
+ end;
+ _ -> ok
+ end
+ end
+ end)())
+ end).
+-endif.
+
+-endif. % ASSERT_HRL
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile
index 55bda60da5..344a5dc099 100644
--- a/lib/stdlib/src/Makefile
+++ b/lib/stdlib/src/Makefile
@@ -122,6 +122,7 @@ MODULES= \
zip
HRL_FILES= \
+ ../include/assert.hrl \
../include/erl_compile.hrl \
../include/erl_bits.hrl \
../include/ms_transform.hrl \
diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile
index 61eb34d565..d4ab674486 100644
--- a/lib/stdlib/test/Makefile
+++ b/lib/stdlib/test/Makefile
@@ -107,7 +107,8 @@ RELSYSDIR = $(RELEASE_PATH)/stdlib_test
ERL_MAKE_FLAGS +=
ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include \
- -I$(ERL_TOP)/lib/kernel/include
+ -I$(ERL_TOP)/lib/kernel/include \
+ -I$(ERL_TOP)/lib/stdlib/include
EBIN = .
diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl
index 206eb4fd74..8ab30eb62b 100644
--- a/lib/stdlib/test/stdlib_SUITE.erl
+++ b/lib/stdlib/test/stdlib_SUITE.erl
@@ -30,7 +30,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [app_test, appup_test, {group,upgrade}].
+ [app_test, appup_test, assert_test, {group,upgrade}].
groups() ->
[{upgrade,[minor_upgrade,major_upgrade]}].
@@ -185,3 +185,68 @@ upgrade_upgraded(_CtData,State) ->
State.
upgrade_downgraded(_CtData,State) ->
State.
+
+
+-include_lib("stdlib/include/assert.hrl").
+-include_lib("stdlib/include/assert.hrl"). % test repeated inclusion
+assert_test(suite) ->
+ [];
+assert_test(doc) ->
+ ["Assert macros test."];
+assert_test(_Config) ->
+ ok = ?assert(true),
+ {'EXIT',{{assert, _},_}} = (catch ?assert(false)),
+ {'EXIT',{{assert, Info1},_}} = (catch ?assert(0)),
+ {not_boolean,0} = lists:keyfind(not_boolean,1,Info1),
+
+ ok = ?assertNot(false),
+ {'EXIT',{{assert, _},_}} = (catch ?assertNot(true)),
+ {'EXIT',{{assert, Info2},_}} = (catch ?assertNot(0)),
+ {not_boolean,0} = lists:keyfind(not_boolean,1,Info2),
+
+ ok = ?assertMatch({foo,_}, {foo,bar}),
+ {'EXIT',{{assertMatch,_},_}} =
+ (catch ?assertMatch({foo,_}, {foo})),
+
+ ok = ?assertMatch({foo,N} when N > 0, {foo,1}),
+ {'EXIT',{{assertMatch,_},_}} =
+ (catch ?assertMatch({foo,N} when N > 0, {foo,0})),
+
+ ok = ?assertNotMatch({foo,_}, {foo,bar,baz}),
+ {'EXIT',{{assertNotMatch,_},_}} =
+ (catch ?assertNotMatch({foo,_}, {foo,baz})),
+
+ ok = ?assertNotMatch({foo,N} when N > 0, {foo,0}),
+ {'EXIT',{{assertNotMatch,_},_}} =
+ (catch ?assertNotMatch({foo,N} when N > 0, {foo,1})),
+
+ ok = ?assertEqual(1.0, 1.0),
+ {'EXIT',{{assertEqual,_},_}} = (catch ?assertEqual(1, 1.0)),
+
+ ok = ?assertNotEqual(1, 1.0),
+ {'EXIT',{{assertNotEqual,_},_}} = (catch ?assertNotEqual(1.0, 1.0)),
+
+ ok = ?assertException(error, badarith, 1/0),
+ ok = ?assertException(exit, foo, exit(foo)),
+ ok = ?assertException(throw, foo, throw(foo)),
+ ok = ?assertException(throw, {foo,_}, throw({foo,bar})),
+ ok = ?assertException(throw, {foo,N} when N > 0, throw({foo,1})),
+ {'EXIT',{{assertException,Why1},_}} =
+ (catch ?assertException(error, badarith, 0/1)),
+ true = lists:keymember(unexpected_success,1,Why1),
+ {'EXIT',{{assertException,Why2},_}} =
+ (catch ?assertException(error, badarith, 1/length(0))),
+ true = lists:keymember(unexpected_exception,1,Why2),
+ {'EXIT',{{assertException,Why3},_}} =
+ (catch ?assertException(throw, {foo,N} when N > 0, throw({foo,0}))),
+ true = lists:keymember(unexpected_exception,1,Why3),
+
+ ok = ?assertNotException(throw, {foo,baz}, throw({foo,bar})),
+ {'EXIT',{{assertNotException,Why4},_}} =
+ (catch ?assertNotException(throw, {foo,bar}, throw({foo,bar}))),
+ true = lists:keymember(unexpected_exception,1,Why4),
+
+ ok = ?assertError(badarith, 1/0),
+ ok = ?assertExit(foo, exit(foo)),
+ ok = ?assertThrow(foo, throw(foo)),
+ ok.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 13:07:10 +0000