aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/common_test/doc/src/ct_slave.xml139
-rw-r--r--lib/common_test/src/ct.erl2
-rw-r--r--lib/compiler/src/beam_block.erl35
-rw-r--r--lib/compiler/src/core_lint.erl25
-rw-r--r--lib/compiler/src/v3_codegen.erl4
-rw-r--r--lib/compiler/src/v3_core.erl78
-rw-r--r--lib/compiler/test/bs_bincomp_SUITE.erl38
-rw-r--r--lib/compiler/test/bs_construct_SUITE.erl4
-rw-r--r--lib/compiler/test/receive_SUITE.erl25
-rw-r--r--lib/dialyzer/RELEASE_NOTES15
-rw-r--r--lib/dialyzer/src/dialyzer_plt.erl8
-rw-r--r--lib/dialyzer/src/dialyzer_races.erl38
-rw-r--r--lib/dialyzer/src/dialyzer_utils.erl12
-rw-r--r--lib/edoc/src/edoc.erl2
-rw-r--r--lib/edoc/src/edoc_run.erl2
-rw-r--r--lib/erl_interface/src/misc/ei_format.c4
-rw-r--r--lib/erl_interface/src/prog/erl_call.c31
-rw-r--r--lib/erl_interface/src/registry/reg_dump.c4
-rw-r--r--lib/erl_interface/src/registry/reg_restore.c2
-rw-r--r--lib/erl_interface/test/ei_format_SUITE.erl2
-rw-r--r--lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c2
-rw-r--r--lib/hipe/cerl/erl_bif_types.erl29
-rw-r--r--lib/hipe/cerl/erl_types.erl325
-rw-r--r--lib/hipe/icode/hipe_beam_to_icode.erl4
-rw-r--r--lib/hipe/icode/hipe_icode_type.erl20
-rw-r--r--lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl52
-rw-r--r--lib/hipe/x86/hipe_x86_spill_restore.erl40
-rw-r--r--lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java5
-rw-r--r--lib/kernel/doc/src/notes.xml23
-rw-r--r--lib/kernel/src/kernel.erl9
-rw-r--r--lib/kernel/test/code_SUITE_data/on_load_app-1.0/src/on_load_embedded.erl9
-rw-r--r--lib/kernel/vsn.mk2
-rw-r--r--lib/mnesia/src/mnesia_controller.erl2
-rw-r--r--lib/mnesia/src/mnesia_locker.erl2
-rw-r--r--lib/mnesia/src/mnesia_log.erl2
-rw-r--r--lib/mnesia/src/mnesia_monitor.erl2
-rw-r--r--lib/mnesia/src/mnesia_recover.erl1
-rw-r--r--lib/mnesia/src/mnesia_subscr.erl2
-rw-r--r--lib/observer/src/Makefile3
-rw-r--r--lib/public_key/asn1/OTP-PKIX.asn113
-rw-r--r--lib/public_key/doc/src/notes.xml4
-rw-r--r--lib/public_key/src/pubkey_cert.erl10
-rw-r--r--lib/public_key/src/public_key.erl1
-rw-r--r--lib/public_key/test/erl_make_certs.erl6
-rw-r--r--lib/ssl/doc/src/ssl.xml11
-rw-r--r--lib/ssl/src/ssl.erl186
-rw-r--r--lib/ssl/src/ssl_certificate.erl7
-rw-r--r--lib/ssl/src/ssl_certificate_db.erl1
-rw-r--r--lib/ssl/src/ssl_cipher.erl54
-rw-r--r--lib/ssl/src/ssl_connection.erl131
-rw-r--r--lib/ssl/src/ssl_handshake.erl143
-rw-r--r--lib/ssl/src/ssl_internal.hrl2
-rw-r--r--lib/ssl/src/ssl_manager.erl2
-rw-r--r--lib/ssl/src/ssl_record.erl97
-rw-r--r--lib/ssl/test/Makefile1
-rw-r--r--lib/ssl/test/erl_make_certs.erl4
-rw-r--r--lib/ssl/test/ssl_basic_SUITE.erl254
-rw-r--r--lib/ssl/test/ssl_session_cache_SUITE.erl305
-rw-r--r--lib/ssl/test/ssl_test_lib.erl10
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl16
-rw-r--r--lib/stdlib/doc/src/filelib.xml8
-rw-r--r--lib/stdlib/doc/src/supervisor.xml2
-rw-r--r--lib/stdlib/src/dets.erl111
-rw-r--r--lib/stdlib/src/digraph.erl2
-rw-r--r--lib/stdlib/src/gb_sets.erl2
-rw-r--r--lib/stdlib/src/lists.erl4
-rw-r--r--lib/stdlib/src/orddict.erl2
-rw-r--r--lib/stdlib/src/ordsets.erl2
-rw-r--r--lib/stdlib/src/supervisor.erl14
-rw-r--r--lib/stdlib/src/timer.erl3
-rw-r--r--lib/stdlib/test/dets_SUITE.erl110
-rw-r--r--lib/stdlib/test/escript_SUITE.erl15
-rwxr-xr-xlib/stdlib/test/escript_SUITE_data/arg_overflow5
-rwxr-xr-xlib/stdlib/test/escript_SUITE_data/linebuf_overflow5
-rw-r--r--lib/stdlib/vsn.mk2
-rw-r--r--lib/syntax_tools/src/epp_dodger.erl2
-rw-r--r--lib/syntax_tools/src/erl_prettypr.erl16
-rw-r--r--lib/syntax_tools/src/erl_recomment.erl5
-rw-r--r--lib/syntax_tools/src/erl_syntax_lib.erl26
-rw-r--r--lib/syntax_tools/src/erl_tidy.erl15
-rw-r--r--lib/syntax_tools/src/igor.erl18
-rw-r--r--lib/test_server/src/ts_install.erl8
-rw-r--r--lib/tools/emacs/erlang.el18
83 files changed, 1591 insertions, 1066 deletions
diff --git a/lib/common_test/doc/src/ct_slave.xml b/lib/common_test/doc/src/ct_slave.xml
deleted file mode 100644
index ceebf51f1a..0000000000
--- a/lib/common_test/doc/src/ct_slave.xml
+++ /dev/null
@@ -1,139 +0,0 @@
-<?xml version="1.0" encoding="latin1" ?>
-<!DOCTYPE erlref SYSTEM "erlref.dtd">
-<erlref>
-<header>
-<title>ct_slave</title>
-<prepared></prepared>
-<responsible></responsible>
-<docno>1</docno>
-<approved></approved>
-<checked></checked>
-<date></date>
-<rev>A</rev>
-<file>ct_slave.xml</file></header>
-<module>ct_slave</module>
-<modulesummary>Common Test Framework functions for starting and stopping nodes for
-Large Scale Testing.</modulesummary>
-<description>
-<p>Common Test Framework functions for starting and stopping nodes for
-Large Scale Testing.</p>
-
- <p>This module exports functions which are used by the Common Test Master
- to start and stop "slave" nodes. It is the default callback module for the
- <c>{init, node_start}</c> term of the Test Specification.</p></description>
-<funcs>
-<func>
-<name>start(Node) -&gt; Result</name>
-<fsummary>Starts an Erlang node with name Node on the local host.</fsummary>
-<type>
-<v>Node = atom()</v><v>Result = {ok, NodeName} | {error, already_started, NodeName} | {error, started_not_connected, NodeName} | {error, boot_timeout, NodeName} | {error, init_timeout, NodeName} | {error, startup_timeout, NodeName} | {error, not_alive, NodeName}</v><v>NodeName = atom()</v></type>
-<desc><marker id="start-1"/>
-
-<p>Starts an Erlang node with name <c>Node</c> on the local host.</p>
-<p><em>See also:</em> <seealso marker="#start-3">start/3</seealso>.</p>
-</desc></func>
-<func>
-<name>start(Host, Node) -&gt; Result</name>
-<fsummary>Starts an Erlang node with name Node on host
- Host with the default options.</fsummary>
-<type>
-<v>Node = atom()</v><v>Host = atom()</v><v>Result = {ok, NodeName} | {error, already_started, NodeName} | {error, started_not_connected, NodeName} | {error, boot_timeout, NodeName} | {error, init_timeout, NodeName} | {error, startup_timeout, NodeName} | {error, not_alive, NodeName}</v><v>NodeName = atom()</v></type>
-<desc><marker id="start-2"/>
-
-<p>Starts an Erlang node with name <c>Node</c> on host
- <c>Host</c> with the default options.</p>
-<p><em>See also:</em> <seealso marker="#start-3">start/3</seealso>.</p>
-</desc></func>
-<func>
-<name>start(Host, Node, Options::Opts) -&gt; Result</name>
-<fsummary>Starts an Erlang node with name Node on host
- Host as specified by the combination of options in
- Opts.</fsummary>
-<type>
-<v>Node = atom()</v><v>Host = atom()</v><v>Opts = [OptTuples]</v><v>OptTuples = {username, Username} | {password, Password} | {boot_timeout, BootTimeout} | {init_timeout, InitTimeout} | {startup_timeout, StartupTimeout} | {startup_functions, StartupFunctions} | {monitor_master, Monitor} | {kill_if_fail, KillIfFail} | {erl_flags, ErlangFlags}</v><v>Username = string()</v><v>Password = string()</v><v>BootTimeout = integer()</v><v>InitTimeout = integer()</v><v>StartupTimeout = integer()</v><v>StartupFunctions = [StartupFunctionSpec]</v><v>StartupFunctionSpec = {Module, Function, Arguments}</v><v>Module = atom()</v><v>Function = atom()</v><v>Arguments = [term]</v><v>Monitor = bool()</v><v>KillIfFail = bool()</v><v>ErlangFlags = string()</v><v>Result = {ok, NodeName} | {error, already_started, NodeName} | {error, started_not_connected, NodeName} | {error, boot_timeout, NodeName} | {error, init_timeout, NodeName} | {error, startup_timeout, NodeName} | {error, not_alive, NodeName}</v><v>NodeName = atom()</v></type>
-<desc><marker id="start-3"/>
-
-<p>Starts an Erlang node with name <c>Node</c> on host
- <c>Host</c> as specified by the combination of options in
- <c>Opts</c>.</p>
-
- <p>Options <c>Username</c> and <c>Password</c> will be used
- to log in onto the remote host <c>Host</c>.
- Username, if omitted, defaults to the current user name,
- and password is empty by default.</p>
-
- <p>A list of functions specified in the <c>Startup</c> option will be
- executed after startup of the node. Note that all used modules should be
- present in the code path on the <c>Host</c>.</p>
-
- <p>The timeouts are applied as follows:
- <list>
- <item>
- <c>BootTimeout</c> - time to start the Erlang node, in seconds.
- Defaults to 3 seconds. If node does not become pingable within this time,
- the result <c>{error, boot_timeout, NodeName}</c> is returned;
- </item>
- <item>
- <c>InitTimeout</c> - time to wait for the node until it calls the
- internal callback function informing master about successfull startup.
- Defaults to one second.
- In case of timed out message the result
- <c>{error, init_timeout, NodeName}</c> is returned;
- </item>
- <item>
- <c>StartupTimeout</c> - time to wait intil the node finishes to run
- the <c>StartupFunctions</c>. Defaults to one second.
- If this timeout occurs, the result
- <c>{error, startup_timeout, NodeName}</c> is returned.
- </item>
- </list></p>
-
- <p>Option <c>monitor_master</c> specifies, if the slave node should be
- stopped in case of master node stop. Defaults to false.</p>
-
- <p>Option <c>kill_if_fail</c> specifies, if the slave node should be
- killed in case of a timeout during initialization or startup.
- Defaults to true. Note that node also may be still alive it the boot
- timeout occurred, but it will not be killed in this case.</p>
-
- <p>Option <c>erlang_flags</c> specifies, which flags will be added
- to the parameters of the <c>erl</c> executable.</p>
-
- <p>Special return values are:
- <list>
- <item><c>{error, already_started, NodeName}</c> - if the node with
- the given name is already started on a given host;</item>
- <item><c>{error, started_not_connected, NodeName}</c> - if node is
- started, but not connected to the master node.</item>
- <item><c>{error, not_alive, NodeName}</c> - if node on which the
- <c>ct_slave:start/3</c> is called, is not alive. Note that
- <c>NodeName</c> is the name of current node in this case.</item>
- </list></p>
-
-</desc></func>
-<func>
-<name>stop(Node) -&gt; Result</name>
-<fsummary>Stops the running Erlang node with name Node on
- the localhost.</fsummary>
-<type>
-<v>Node = atom()</v><v>Result = {ok, NodeName} | {error, not_started, NodeName} | {error, not_connected, NodeName} | {error, stop_timeout, NodeName}</v><v>NodeName = atom()</v></type>
-<desc><marker id="stop-1"/>
-
-<p>Stops the running Erlang node with name <c>Node</c> on
- the localhost.</p>
-</desc></func>
-<func>
-<name>stop(Host, Node) -&gt; Result</name>
-<fsummary>Stops the running Erlang node with name Node on
- host Host.</fsummary>
-<type>
-<v>Host = atom()</v><v>Node = atom()</v><v>Result = {ok, NodeName} | {error, not_started, NodeName} | {error, not_connected, NodeName} | {error, stop_timeout, NodeName}</v><v>NodeName = atom()</v></type>
-<desc><marker id="stop-2"/>
-
-<p>Stops the running Erlang node with name <c>Node</c> on
- host <c>Host</c>.</p>
-</desc></func></funcs>
-
-<authors>
-<aname> </aname>
-<email> </email></authors></erlref> \ No newline at end of file
diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl
index 8ae175f10d..1dbf83ee10 100644
--- a/lib/common_test/src/ct.erl
+++ b/lib/common_test/src/ct.erl
@@ -694,7 +694,7 @@ userdata(TestDir, Suite, Case) ->
%%%-----------------------------------------------------------------
-%%% @spec get_status() -> TestStatus | {error,Reason}
+%%% @spec get_status() -> TestStatus | {error,Reason} | no_tests_running
%%% TestStatus = [StatusElem]
%%% StatusElem = {current,{Suite,TestCase}} | {successful,Successful} |
%%% {failed,Failed} | {skipped,Skipped} | {total,Total}
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index 9c6f835ab0..c45874597a 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -36,12 +36,13 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
%% Collect basic blocks and optimize them.
Is2 = blockify(Is1),
- Is3 = beam_utils:live_opt(Is2),
- Is4 = opt_blocks(Is3),
- Is5 = beam_utils:delete_live_annos(Is4),
+ Is3 = move_allocates(Is2),
+ Is4 = beam_utils:live_opt(Is3),
+ Is5 = opt_blocks(Is4),
+ Is6 = beam_utils:delete_live_annos(Is5),
%% Optimize bit syntax.
- {Is,Lc} = bsm_opt(Is5, Lc0),
+ {Is,Lc} = bsm_opt(Is6, Lc0),
%% Done.
{{function,Name,Arity,CLabel,Is},Lc}
@@ -156,11 +157,7 @@ opt_blocks([I|Is]) ->
opt_blocks([]) -> [].
opt_block(Is0) ->
- %% We explicitly move any allocate instruction upwards before optimising
- %% moves, to avoid any potential problems with the calculation of live
- %% registers.
- Is1 = move_allocates(Is0),
- Is = find_fixpoint(fun opt/1, Is1),
+ Is = find_fixpoint(fun opt/1, Is0),
opt_alloc(Is).
find_fixpoint(OptFun, Is0) ->
@@ -170,11 +167,21 @@ find_fixpoint(OptFun, Is0) ->
end.
%% move_allocates(Is0) -> Is
-%% Move allocates upwards in the instruction stream, in the hope of
-%% getting more possibilities for optimizing away moves later.
-
-move_allocates(Is) ->
- move_allocates_1(reverse(Is), []).
+%% Move allocate instructions upwards in the instruction stream, in the
+%% hope of getting more possibilities for optimizing away moves later.
+%%
+%% NOTE: Moving allocation instructions is only safe because it is done
+%% immediately after code generation so that we KNOW that if {x,X} is
+%% initialized, all x registers with lower numbers are also initialized.
+%% That assumption may not be true after other optimizations, such as
+%% the beam_utils:live_opt/1 optimization.
+
+move_allocates([{block,Bl0}|Is]) ->
+ Bl = move_allocates_1(reverse(Bl0), []),
+ [{block,Bl}|move_allocates(Is)];
+move_allocates([I|Is]) ->
+ [I|move_allocates(Is)];
+move_allocates([]) -> [].
move_allocates_1([{set,[],[],{alloc,_,_}=Alloc}|Is0], Acc0) ->
{Is,Acc} = move_allocates_2(Alloc, Is0, Acc0),
diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl
index b633f568c9..b513a8965c 100644
--- a/lib/compiler/src/core_lint.erl
+++ b/lib/compiler/src/core_lint.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -65,7 +65,8 @@
| {'return_mismatch', fa()} | {'undefined_function', fa()}
| {'duplicate_var', cerl:var_name(), fa()}
| {'unbound_var', cerl:var_name(), fa()}
- | {'undefined_function', fa(), fa()}.
+ | {'undefined_function', fa(), fa()}
+ | {'tail_segment_not_at_end', fa()}.
-type error() :: {module(), err_desc()}.
-type warning() :: {module(), term()}.
@@ -116,7 +117,9 @@ format_error({duplicate_var,N,{F,A}}) ->
format_error({unbound_var,N,{F,A}}) ->
io_lib:format("unbound variable ~s in ~w/~w", [N,F,A]);
format_error({undefined_function,{F1,A1},{F2,A2}}) ->
- io_lib:format("undefined function ~w/~w in ~w/~w", [F1,A1,F2,A2]).
+ io_lib:format("undefined function ~w/~w in ~w/~w", [F1,A1,F2,A2]);
+format_error({tail_segment_not_at_end,{F,A}}) ->
+ io_lib:format("binary tail segment not at end in ~w/~w", [F,A]).
-type ret() :: {'ok', [{module(), [warning(),...]}]}
| {'error', [{module(), [error(),...]}],
@@ -450,7 +453,8 @@ pattern(#c_cons{hd=H,tl=T}, Def, Ps, St) ->
pattern_list([H,T], Def, Ps, St);
pattern(#c_tuple{es=Es}, Def, Ps, St) ->
pattern_list(Es, Def, Ps, St);
-pattern(#c_binary{segments=Ss}, Def, Ps, St) ->
+pattern(#c_binary{segments=Ss}, Def, Ps, St0) ->
+ St = pat_bin_tail_check(Ss, St0),
pat_bin(Ss, Def, Ps, St);
pattern(#c_alias{var=V,pat=P}, Def, Ps, St0) ->
{Vvs,St1} = variable(V, Ps, St0),
@@ -482,6 +486,19 @@ pat_segment(#c_bitstr{val=V,size=S,type=T}, Def0, Ps0, St0) ->
pat_segment(_, Def, Ps, St) ->
{Ps,Def,add_error({not_bs_pattern,St#lint.func}, St)}.
+%% pat_bin_tail_check([Elem], State) -> State.
+%% There must be at most one tail segment (a size-less segment of
+%% type binary) and it must occur at the end.
+
+pat_bin_tail_check([#c_bitstr{size=#c_literal{val=all}}], St) ->
+ %% Size-less field is OK at the end of the list of segments.
+ St;
+pat_bin_tail_check([#c_bitstr{size=#c_literal{val=all}}|_], St) ->
+ add_error({tail_segment_not_at_end,St#lint.func}, St);
+pat_bin_tail_check([_|Ss], St) ->
+ pat_bin_tail_check(Ss, St);
+pat_bin_tail_check([], St) -> St.
+
%% pat_bit_expr(SizePat, Type, Defined, State) -> State.
%% Check the Size pattern, this is an input! Because of optimizations,
%% we must allow any kind of constant and literal here.
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 948937c438..77da6c8d00 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -1523,7 +1523,9 @@ cg_binary_size_1([], Bits, Acc) ->
[{1,_}|_] ->
{bs_init_bits,cg_binary_bytes_to_bits(Sizes, [])};
[{8,_}|_] ->
- {bs_init2,[E || {8,E} <- Sizes]}
+ {bs_init2,[E || {8,E} <- Sizes]};
+ [] ->
+ {bs_init_bits,[]}
end.
cg_binary_size_2({integer,N}, U, _, Next, Bits, Acc) ->
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index f6bb45787c..2da24b2908 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -892,25 +892,22 @@ lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], Mc, St0) ->
lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) ->
{Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Name,St1} = new_fun_name("blc", St0),
- {Tname,St2} = new_var_name(St1),
- LA = lineno_anno(Line, St2),
+ LA = lineno_anno(Line, St1),
LAnno = #a{anno=LA},
- HeadBinPattern = pattern(P,St2),
- #c_binary{segments=Ps} = HeadBinPattern,
- {EPs,St3} = emasculate_segments(Ps,St2),
- Tail = #c_var{anno=LA,name=Tname},
- TailSegment = #c_bitstr{val=Tail,size=#c_literal{val=all},
- unit=#c_literal{val=1},
- type=#c_literal{val=binary},
- flags=#c_literal{val=[big,unsigned]}},
- Pattern = HeadBinPattern#c_binary{segments=Ps ++ [TailSegment]},
- EPattern = HeadBinPattern#c_binary{segments=EPs ++ [TailSegment]},
+ HeadBinPattern = pattern(P, St1),
+ #c_binary{segments=Ps0} = HeadBinPattern,
+ {Ps,Tail,St2} = append_tail_segment(Ps0, St1),
+ {EPs,St3} = emasculate_segments(Ps, St2),
+ Pattern = HeadBinPattern#c_binary{segments=Ps},
+ EPattern = HeadBinPattern#c_binary{segments=EPs},
{Arg,St4} = new_var(St3),
{Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat!
+ Tname = Tail#c_var.name,
{Nc,[],St6} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St5),
{Bc,Bps,St7} = lc_tq(Line, E, Qs1, Nc, St6),
{Gc,Gps,St10} = safe(G, St7), %Will be a function argument!
Fc = function_clause([Arg], LA, {Name,1}),
+ {TailSegList,_,St} = append_tail_segment([], St10),
Cs = [#iclause{anno=#a{anno=[compiler_generated|LA]},
pats=[Pattern],
guard=Guardc,
@@ -922,14 +919,14 @@ lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) ->
op=#c_var{anno=LA,name={Name,1}},
args=[Tail]}]},
#iclause{anno=LAnno,
- pats=[#c_binary{anno=LA, segments=[TailSegment]}],guard=[],
+ pats=[#c_binary{anno=LA,segments=TailSegList}],guard=[],
body=[Mc]}],
Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc},
{#iletrec{anno=LAnno,defs=[{{Name,1},Fun}],
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,1}},
args=[Gc]}]},
- [],St10};
+ [],St};
lc_tq(Line, E, [Fil0|Qs0], Mc, St0) ->
%% Special case sequences guard tests.
LA = lineno_anno(Line, St0),
@@ -1037,26 +1034,24 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
{Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Name,St1} = new_fun_name("lbc", St0),
LA = lineno_anno(Line, St1),
- {[Tail,AccVar],St2} = new_vars(LA, 2, St1),
+ {AccVar,St2} = new_var(LA, St1),
LAnno = #a{anno=LA},
HeadBinPattern = pattern(P, St2),
- #c_binary{segments=Ps} = HeadBinPattern,
- {EPs,St3} = emasculate_segments(Ps, St2),
- TailSegment = #c_bitstr{val=Tail,size=#c_literal{val=all},
- unit=#c_literal{val=1},
- type=#c_literal{val=binary},
- flags=#c_literal{val=[big,unsigned]}},
- Pattern = HeadBinPattern#c_binary{segments=Ps ++ [TailSegment]},
- EPattern = HeadBinPattern#c_binary{segments=EPs ++ [TailSegment]},
- {Arg,St4} = new_var(St3),
+ #c_binary{segments=Ps0} = HeadBinPattern,
+ {Ps,Tail,St3} = append_tail_segment(Ps0, St2),
+ {EPs,St4} = emasculate_segments(Ps, St3),
+ Pattern = HeadBinPattern#c_binary{segments=Ps},
+ EPattern = HeadBinPattern#c_binary{segments=EPs},
+ {Arg,St5} = new_var(St4),
NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name},
{var,Lg,AccVar#c_var.name}]},
- {Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat!
- {Bc,Bps,St6} = bc_tq1(Line, E, Qs1, AccVar, St5),
- {Nc,Nps,St7} = expr(NewMore, St6),
- {Gc,Gps,St8} = safe(G, St7), %Will be a function argument!
+ {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat!
+ {Bc,Bps,St7} = bc_tq1(Line, E, Qs1, AccVar, St6),
+ {Nc,Nps,St8} = expr(NewMore, St7),
+ {Gc,Gps,St9} = safe(G, St8), %Will be a function argument!
Fc = function_clause([Arg,AccVar], LA, {Name,2}),
Body = Bps ++ Nps ++ [#iset{var=AccVar,arg=Bc},Nc],
+ {TailSegList,_,St} = append_tail_segment([], St9),
Cs = [#iclause{anno=LAnno,
pats=[Pattern,AccVar],
guard=Guardc,
@@ -1066,7 +1061,7 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
guard=[],
body=Nps ++ [Nc]},
#iclause{anno=LAnno,
- pats=[#c_binary{anno=LA,segments=[TailSegment]},AccVar],
+ pats=[#c_binary{anno=LA,segments=TailSegList},AccVar],
guard=[],
body=[AccVar]}],
Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc},
@@ -1074,7 +1069,7 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,2}},
args=[Gc,AccExpr]}]},
- [],St8};
+ [],St};
bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) ->
%% Special case sequences guard tests.
LA = lineno_anno(Line, St0),
@@ -1120,6 +1115,29 @@ bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) ->
%%Anno = Anno0#a{anno=[compiler_generated|A]},
{set_anno(E, Anno),Pre,St}.
+append_tail_segment(Segs, St) ->
+ app_tail_seg(Segs, St, []).
+
+app_tail_seg([#c_bitstr{val=Var0,size=#c_literal{val=all}}=Seg0]=L,
+ St0, Acc) ->
+ case Var0 of
+ #c_var{name='_'} ->
+ {Var,St} = new_var(St0),
+ Seg = Seg0#c_bitstr{val=Var},
+ {reverse(Acc, [Seg]),Var,St};
+ #c_var{} ->
+ {reverse(Acc, L),Var0,St0}
+ end;
+app_tail_seg([H|T], St, Acc) ->
+ app_tail_seg(T, St, [H|Acc]);
+app_tail_seg([], St0, Acc) ->
+ {Var,St} = new_var(St0),
+ Tail = #c_bitstr{val=Var,size=#c_literal{val=all},
+ unit=#c_literal{val=1},
+ type=#c_literal{val=binary},
+ flags=#c_literal{val=[unsigned,big]}},
+ {reverse(Acc, [Tail]),Var,St}.
+
emasculate_segments(Segs, St) ->
emasculate_segments(Segs, St, []).
diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl
index a64a5d590b..74f69893af 100644
--- a/lib/compiler/test/bs_bincomp_SUITE.erl
+++ b/lib/compiler/test/bs_bincomp_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -24,7 +24,7 @@
-export([all/1,
byte_aligned/1,bit_aligned/1,extended_byte_aligned/1,
extended_bit_aligned/1,mixed/1,filters/1,trim_coverage/1,
- nomatch/1,sizes/1]).
+ nomatch/1,sizes/1,tail/1]).
-include("test_server.hrl").
@@ -32,7 +32,7 @@ all(suite) ->
test_lib:recompile(?MODULE),
[byte_aligned,bit_aligned,extended_byte_aligned,
extended_bit_aligned,mixed,filters,trim_coverage,
- nomatch,sizes].
+ nomatch,sizes,tail].
byte_aligned(Config) when is_list(Config) ->
@@ -270,6 +270,38 @@ sizes(Config) when is_list(Config) ->
?line cs_end(),
ok.
+tail(Config) when is_list(Config) ->
+ ?line [] = tail_1(<<0:7>>),
+ ?line [0] = tail_1(<<0>>),
+ ?line [0] = tail_1(<<0:12>>),
+ ?line [0,0] = tail_1(<<0:20>>),
+
+ ?line [] = tail_2(<<0:7>>),
+ ?line [42] = tail_2(<<0>>),
+ ?line [] = tail_2(<<0:12>>),
+ ?line [42,42] = tail_2(<<0,1>>),
+
+ ?line <<>> = tail_3(<<0:7>>),
+ ?line <<42>> = tail_3(<<0>>),
+ ?line <<42>> = tail_3(<<0:12>>),
+ ?line <<42,42>> = tail_3(<<0:20>>),
+
+ ?line [] = tail_4(<<0:15>>),
+ ?line [7] = tail_4(<<7,8>>),
+ ?line [9] = tail_4(<<9,17:12>>),
+ ok.
+
+tail_1(Bits) ->
+ [X || <<X:8/integer, _/bits>> <= Bits].
+
+tail_2(Bits) ->
+ [42 || <<_:8/integer, _/bytes>> <= Bits].
+
+tail_3(Bits) ->
+ << <<42>> || <<_:8/integer, _/bits>> <= Bits >>.
+
+tail_4(Bits) ->
+ [X || <<X:8/integer, Tail/bits>> <= Bits, bit_size(Tail) >= 8].
cs_init() ->
diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl
index 1862a28bbe..dfe4301791 100644
--- a/lib/compiler/test/bs_construct_SUITE.erl
+++ b/lib/compiler/test/bs_construct_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -66,6 +66,8 @@ id(I) -> I.
l(I_13, I_big1, I_16, Bin) ->
[
+ ?T(<<I_13:0>>,
+ []),
?T(<<-43>>,
[256-43]),
?T(<<4:4,7:4>>,
diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl
index fca3f0387b..2a592dd669 100644
--- a/lib/compiler/test/receive_SUITE.erl
+++ b/lib/compiler/test/receive_SUITE.erl
@@ -21,7 +21,7 @@
-module(receive_SUITE).
-export([all/1,init_per_testcase/2,fin_per_testcase/2,
- recv/1,coverage/1,otp_7980/1,ref_opt/1]).
+ recv/1,coverage/1,otp_7980/1,ref_opt/1,export/1]).
-include("test_server.hrl").
@@ -36,7 +36,7 @@ fin_per_testcase(_Case, Config) ->
all(suite) ->
test_lib:recompile(?MODULE),
- [recv,coverage,otp_7980,ref_opt].
+ [recv,coverage,otp_7980,ref_opt,export].
-record(state, {ena = true}).
@@ -205,4 +205,25 @@ collect_recv_opt_instrs(Code) ->
end] || {function,_,_,_,Is} <- Code],
lists:append(L).
+export(Config) when is_list(Config) ->
+ Ref = make_ref(),
+ ?line self() ! {result,Ref,42},
+ ?line 42 = export_1(Ref),
+ ?line {error,timeout} = export_1(Ref),
+ ok.
+
+export_1(Reference) ->
+ id(Reference),
+ receive
+ {result,Reference,Result} ->
+ Result
+ after 1 ->
+ Result = {error,timeout}
+ end,
+ %% Result ({x,1}) is used, but not the return value ({x,0})
+ %% of the receive. Used to be incorrectly optimized
+ %% by beam_block.
+ id({build,self()}),
+ Result.
+
id(I) -> I.
diff --git a/lib/dialyzer/RELEASE_NOTES b/lib/dialyzer/RELEASE_NOTES
index 62b0c92f97..a05b3ac52b 100644
--- a/lib/dialyzer/RELEASE_NOTES
+++ b/lib/dialyzer/RELEASE_NOTES
@@ -3,8 +3,19 @@
(in reversed chronological order)
==============================================================================
-Version 2.3.0 (in Erlang/OTP R14)
----------------------------------
+Version 2.x.x (in Erlang/OTP R14B01)
+------------------------------------
+ - Fixed problems in the handling of remote types in records used as types
+ (thanks to Nico Kruber for the report and to Maria Christakis for the fix).
+ - Fixed handling of nested opaque types (thanks to Thorsten Schuett for
+ reporting it and to Maria Christakis for fixing it).
+
+Version 2.3.1 (in Erlang/OTP R14B)
+----------------------------------
+ - Eliminated warnings for auto-imported BIF clashes.
+
+Version 2.3.0 (in Erlang/OTP R14A)
+----------------------------------
- Dialyzer properly supports the new attribute -export_type and checks
that remote types only refer to exported types. A warning is produced
if some files/applications refer to types defined in modules which are
diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl
index 0f5be3b7f2..08d0b318b5 100644
--- a/lib/dialyzer/src/dialyzer_plt.erl
+++ b/lib/dialyzer/src/dialyzer_plt.erl
@@ -244,9 +244,10 @@ from_file(FileName, ReturnInfo) ->
[FileName, Reason]))
end.
--type inc_file_err_rsn() :: 'no_such_file' | 'read_error'.
+-type err_rsn() :: 'not_valid' | 'no_such_file' | 'read_error'.
+
-spec included_files(file:filename()) -> {'ok', [file:filename()]}
- | {'error', inc_file_err_rsn()}.
+ | {'error', err_rsn()}.
included_files(FileName) ->
case get_record_from_file(FileName) of
@@ -320,8 +321,7 @@ to_file(FileName,
end.
-type md5_diff() :: [{'differ', atom()} | {'removed', atom()}].
--type check_error() :: 'not_valid' | 'no_such_file' | 'read_error'
- | {'no_file_to_remove', file:filename()}.
+-type check_error() :: err_rsn() | {'no_file_to_remove', file:filename()}.
-spec check_plt(file:filename(), [file:filename()], [file:filename()]) ->
'ok'
diff --git a/lib/dialyzer/src/dialyzer_races.erl b/lib/dialyzer/src/dialyzer_races.erl
index ec8d613b96..ee9d5e88a3 100644
--- a/lib/dialyzer/src/dialyzer_races.erl
+++ b/lib/dialyzer/src/dialyzer_races.erl
@@ -118,7 +118,7 @@
var_map :: dict()}).
-type case_tags() :: 'beg_case' | #beg_clause{} | #end_clause{} | #end_case{}.
--type code() :: [#dep_call{} | #warn_call{} | #fun_call{} |
+-type code() :: [#dep_call{} | #fun_call{} | #warn_call{} |
#curr_fun{} | #let_tag{} | case_tags() | race_tag()].
-type table_var() :: label() | ?no_label.
@@ -479,23 +479,11 @@ fixup_race_forward(CurrFun, CurrFunLabel, Calls, Code, RaceList,
_Other ->
{RaceList, [], NestingLevel, false}
end;
- #dep_call{call_name = ets_lookup, args = DepCallArgs} ->
+ #dep_call{call_name = ets_lookup} ->
case RaceWarnTag of
?WARN_ETS_LOOKUP_INSERT ->
- [Tab, Names, _, _] = DepCallArgs,
- case compare_var_list(Tab,
- dialyzer_callgraph:get_public_tables(Callgraph),
- RaceVarMap)
- orelse
- length(Names --
- dialyzer_callgraph:get_named_tables(Callgraph)) <
- length(Names) of
- true ->
- {[Head#dep_call{var_map = RaceVarMap}|RaceList],
- [], NestingLevel, false};
- false ->
- {RaceList, [], NestingLevel, false}
- end;
+ {[Head#dep_call{var_map = RaceVarMap}|RaceList],
+ [], NestingLevel, false};
_Other ->
{RaceList, [], NestingLevel, false}
end;
@@ -517,23 +505,11 @@ fixup_race_forward(CurrFun, CurrFunLabel, Calls, Code, RaceList,
_Other ->
{RaceList, [], NestingLevel, false}
end;
- #warn_call{call_name = ets_insert, args = WarnCallArgs} ->
+ #warn_call{call_name = ets_insert} ->
case RaceWarnTag of
?WARN_ETS_LOOKUP_INSERT ->
- [Tab, Names, _, _] = WarnCallArgs,
- case compare_var_list(Tab,
- dialyzer_callgraph:get_public_tables(Callgraph),
- RaceVarMap)
- orelse
- length(Names --
- dialyzer_callgraph:get_named_tables(Callgraph)) <
- length(Names) of
- true ->
- {[Head#warn_call{var_map = RaceVarMap}|RaceList],
- [], NestingLevel, false};
- false ->
- {RaceList, [], NestingLevel, false}
- end;
+ {[Head#warn_call{var_map = RaceVarMap}|RaceList],
+ [], NestingLevel, false};
_Other ->
{RaceList, [], NestingLevel, false}
end;
diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index a9da229061..248fdf6835 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -66,7 +66,7 @@ print_types1([{opaque, _Name} = Key|T], RecDict) ->
io:format("\n~w: ~w\n", [Key, erl_types:t_from_form(Form, RecDict)]),
print_types1(T, RecDict);
print_types1([{record, _Name} = Key|T], RecDict) ->
- {ok, [{Arity, Fields} = AF]} = dict:find(Key, RecDict),
+ {ok, [{_Arity, _Fields} = AF]} = dict:find(Key, RecDict),
io:format("~w: ~w\n\n", [Key, AF]),
print_types1(T, RecDict).
-define(debug(D_), print_types(D_)).
@@ -211,9 +211,9 @@ get_record_and_type_info([_Other|Left], Module, Records, RecDict) ->
get_record_and_type_info([], _Module, Records, RecDict) ->
case type_record_fields(lists:reverse(Records), RecDict) of
{ok, _NewRecDict} = Ok ->
- ?debug(NewRecDict),
+ ?debug(_NewRecDict),
Ok;
- {Name, {error, Error}} ->
+ {error, Name, Error} ->
{error, lists:flatten(io_lib:format(" Error while parsing #~w{}: ~s\n",
[Name, Error]))}
end.
@@ -269,9 +269,9 @@ type_record_fields([RecKey|Recs], RecDict) ->
RecDict2 = dict:update(RecKey, Fun, RecDict1),
type_record_fields(Recs, RecDict2)
catch
- throw:{error, _} = Error ->
+ throw:{error, Error} ->
{record, Name} = RecKey,
- {Name, Error}
+ {error, Name, Error}
end.
-spec process_record_remote_types(dialyzer_codeserver:codeserver()) -> dialyzer_codeserver:codeserver().
@@ -378,7 +378,7 @@ sets_filter([Mod|Mods], ExpTypes) ->
-spec src_compiler_opts() -> [compile:option(),...].
src_compiler_opts() ->
- [no_copt, to_core, binary, return_errors,
+ [no_copt, to_core, binary, return_errors,
no_inline, strict_record_tests, strict_record_updates,
no_is_record_optimization].
diff --git a/lib/edoc/src/edoc.erl b/lib/edoc/src/edoc.erl
index ec452a5929..75b3bb451a 100644
--- a/lib/edoc/src/edoc.erl
+++ b/lib/edoc/src/edoc.erl
@@ -58,6 +58,8 @@
read_comments/1, read_comments/2,
read_source/1, read_source/2]).
+-compile({no_auto_import,[error/1]}).
+
-import(edoc_report, [report/2, report/3, error/1, error/3]).
-include("edoc.hrl").
diff --git a/lib/edoc/src/edoc_run.erl b/lib/edoc/src/edoc_run.erl
index 37025d6621..96e5ea4631 100644
--- a/lib/edoc/src/edoc_run.erl
+++ b/lib/edoc/src/edoc_run.erl
@@ -42,6 +42,8 @@
-export([file/1, application/1, packages/1, files/1, toc/1]).
+-compile({no_auto_import,[error/1]}).
+
-import(edoc_report, [report/2, error/1]).
diff --git a/lib/erl_interface/src/misc/ei_format.c b/lib/erl_interface/src/misc/ei_format.c
index 08235d0ebe..b35421d4b2 100644
--- a/lib/erl_interface/src/misc/ei_format.c
+++ b/lib/erl_interface/src/misc/ei_format.c
@@ -106,6 +106,8 @@ static int eiformat(const char** fmt, union arg** args, ei_x_buff* x)
default:
if (isdigit((int)*p))
res = pdigit(&p, x);
+ else if ((*p == '-' || *p == '+') && isdigit((int)*(p+1)))
+ res = pdigit(&p, x);
else if (islower((int)*p))
res = patom(&p, x);
else
@@ -149,6 +151,8 @@ static int pdigit(const char** fmt, ei_x_buff* x)
double d;
long l;
+ if (**fmt == '-' || **fmt == '+')
+ (*fmt)++;
for (;;) {
c = *(*fmt)++;
if (isdigit((int)c))
diff --git a/lib/erl_interface/src/prog/erl_call.c b/lib/erl_interface/src/prog/erl_call.c
index 448de9aa23..33ff6da7c9 100644
--- a/lib/erl_interface/src/prog/erl_call.c
+++ b/lib/erl_interface/src/prog/erl_call.c
@@ -118,7 +118,6 @@ static void usage_arg(const char *progname, const char *switchname);
static void usage_error(const char *progname, const char *switchname);
static void usage(const char *progname);
static int get_module(char **mbuf, char **mname);
-static struct hostent* get_hostent(char *host);
static int do_connect(ei_cnode *ec, char *nodename, struct call_flags *flags);
static int read_stdin(char **buf);
static void split_apply_string(char *str, char **mod,
@@ -367,8 +366,8 @@ int erl_call(int argc, char **argv)
* Expand name to a real name (may be ip-address)
*/
/* FIXME better error string */
- if ((hp = get_hostent(host)) == 0) {
- fprintf(stderr,"erl_call: can't get_hostent(%s)\n", host);
+ if ((hp = ei_gethostbyname(host)) == 0) {
+ fprintf(stderr,"erl_call: can't ei_gethostbyname(%s)\n", host);
exit(1);
}
/* If shortnames, cut off the name at first '.' */
@@ -604,32 +603,6 @@ int erl_call(int argc, char **argv)
*
***************************************************************************/
-/*
- * Get host entry (by address or name)
- */
-/* FIXME: will fail on names like '2fun4you'. */
-static struct hostent* get_hostent(char *host)
-{
- if (isdigit((int)*host)) {
- struct in_addr ip_addr;
- int b1, b2, b3, b4;
- long addr;
-
- /* FIXME: Use inet_aton() (or inet_pton() and get v6 for free). */
- if (sscanf(host, "%d.%d.%d.%d", &b1, &b2, &b3, &b4) != 4) {
- return NULL;
- }
- addr = inet_addr(host);
- ip_addr.s_addr = htonl(addr);
-
- return ei_gethostbyaddr((char *)&ip_addr,sizeof(struct in_addr), AF_INET);
- }
-
- return ei_gethostbyname(host);
-} /* get_hostent */
-
-
-
/*
* This function does only return on success.
diff --git a/lib/erl_interface/src/registry/reg_dump.c b/lib/erl_interface/src/registry/reg_dump.c
index 50a6949177..dfec96b43c 100644
--- a/lib/erl_interface/src/registry/reg_dump.c
+++ b/lib/erl_interface/src/registry/reg_dump.c
@@ -157,7 +157,7 @@ static int mn_send_delete(int fd, erlang_pid *mnesia, const char *key)
int len = strlen(key) + 32; /* 32 is a slight overestimate */
if (len > EISMALLBUF)
- if (!(dbuf = malloc(index)))
+ if (!(dbuf = malloc(len)))
return -1;
msgbuf = (dbuf ? dbuf : sbuf);
@@ -187,7 +187,7 @@ static int mn_send_write(int fd, erlang_pid *mnesia, const char *key, ei_reg_obj
int len = 32 + keylen + obj->size;
if (len > EISMALLBUF)
- if (!(dbuf = malloc(index)))
+ if (!(dbuf = malloc(len)))
return -1;
msgbuf = (dbuf ? dbuf : sbuf);
diff --git a/lib/erl_interface/src/registry/reg_restore.c b/lib/erl_interface/src/registry/reg_restore.c
index 27918d2364..aeb33c784a 100644
--- a/lib/erl_interface/src/registry/reg_restore.c
+++ b/lib/erl_interface/src/registry/reg_restore.c
@@ -266,7 +266,7 @@ int ei_reg_restore(int fd, ei_reg *reg, const char *mntab)
/* make sure receive buffer can handle largest expected message */
len = maxkey + maxobj + 512;
if (len > EISMALLBUF)
- if (!(dbuf = malloc(index))) {
+ if (!(dbuf = malloc(len))) {
ei_send_exit(fd,&self,&mnesia,"cannot allocate space for incoming data");
return -1;
}
diff --git a/lib/erl_interface/test/ei_format_SUITE.erl b/lib/erl_interface/test/ei_format_SUITE.erl
index 7871f07ae9..cbe9fa52d7 100644
--- a/lib/erl_interface/test/ei_format_SUITE.erl
+++ b/lib/erl_interface/test/ei_format_SUITE.erl
@@ -155,7 +155,7 @@ format_wo_ver(suite) -> [];
format_wo_ver(Config) when is_list(Config) ->
?line P = runner:start(?format_wo_ver),
- ?line {term, [{a, "b"}, {c, 10}]} = get_term(P),
+ ?line {term, [-1, 2, {a, "b"}, {c, 10}]} = get_term(P),
?line runner:recv_eot(P),
ok.
diff --git a/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c b/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c
index a969ded3dc..ecdce402f5 100644
--- a/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c
+++ b/lib/erl_interface/test/ei_format_SUITE_data/ei_format_test.c
@@ -176,7 +176,7 @@ TESTCASE(format_wo_ver) {
ei_x_buff x;
ei_x_new (&x);
- ei_x_format(&x, "[{~a,~s},{~a,~i}]", "a", "b", "c", 10);
+ ei_x_format(&x, "[-1, +2, {~a,~s},{~a,~i}]", "a", "b", "c", 10);
send_bin_term(&x);
free(x.buff);
diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl
index 6eeeab3610..835f9a205a 100644
--- a/lib/hipe/cerl/erl_bif_types.erl
+++ b/lib/hipe/cerl/erl_bif_types.erl
@@ -1219,7 +1219,7 @@ type(erlang, monitor_node, 3, Xs) ->
strict(arg_types(erlang, monitor_node, 3), Xs,
fun (_) -> t_atom('true') end);
type(erlang, nif_error, 1, _) ->
- t_any();
+ t_any(); % this BIF and the next one are stubs for NIFs and never return
type(erlang, nif_error, 2, Xs) ->
strict(arg_types(erlang, nif_error, 2), Xs, fun (_) -> t_any() end);
type(erlang, node, 0, _) -> t_node();
@@ -1970,7 +1970,25 @@ type(ets, slot, 2, Xs) ->
strict(arg_types(ets, slot, 2), Xs,
fun (_) -> t_sup(t_list(t_tuple()), t_atom('$end_of_table')) end);
type(ets, update_counter, 3, Xs) ->
- strict(arg_types(ets, update_counter, 3), Xs, fun (_) -> t_integer() end);
+ strict(arg_types(ets, update_counter, 3), Xs,
+ fun ([_, _, Op]) ->
+ case t_is_integer(Op) of
+ true -> t_integer();
+ false ->
+ case t_is_tuple(Op) of
+ true -> t_integer();
+ false ->
+ case t_is_list(Op) of
+ true -> t_list(t_integer());
+ false ->
+ case t_is_nil(Op) of
+ true -> t_nil();
+ false -> t_sup([t_integer(), t_list(t_integer())])
+ end
+ end
+ end
+ end
+ end);
type(ets, update_element, 3, Xs) ->
strict(arg_types(ets, update_element, 3), Xs, fun (_) -> t_boolean() end);
%%-- file ---------------------------------------------------------------------
@@ -4181,10 +4199,9 @@ arg_types(ets, setopts, 2) ->
t_tuple([t_atom('heir'), t_atom('none')])),
[t_tab(), t_sup(Opt, t_list(Opt))];
arg_types(ets, update_counter, 3) ->
- [t_tab(), t_any(), t_sup(t_integer(),
- t_sup(t_tuple([t_integer(), t_integer()]),
- t_tuple([t_integer(), t_integer(),
- t_integer(), t_integer()])))];
+ Int = t_integer(),
+ UpdateOp = t_sup(t_tuple([Int, Int]), t_tuple([Int, Int, Int, Int])),
+ [t_tab(), t_any(), t_sup([UpdateOp, t_list(UpdateOp), Int])];
arg_types(ets, update_element, 3) ->
PosValue = t_tuple([t_integer(), t_any()]),
[t_tab(), t_any(), t_sup(PosValue, t_list(PosValue))];
diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl
index 9a40be6d14..9bc56c99ff 100644
--- a/lib/hipe/cerl/erl_types.erl
+++ b/lib/hipe/cerl/erl_types.erl
@@ -3390,197 +3390,248 @@ t_from_form(Form, RecDict) ->
-spec t_from_form(parse_form(), dict(), dict()) -> erl_type().
t_from_form(Form, RecDict, VarDict) ->
- {T, _R} = t_from_form(Form, [], RecDict, VarDict),
+ {T, _R} = t_from_form(Form, [], false, RecDict, VarDict),
T.
-type type_names() :: [{'type' | 'opaque' | 'record', atom()}].
--spec t_from_form(parse_form(), type_names(), dict(), dict()) ->
+-spec t_from_form(parse_form(), type_names(), boolean(), dict(), dict()) ->
{erl_type(), type_names()}.
-t_from_form({var, _L, '_'}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({var, _L, '_'}, _TypeNames, _InOpaque, _RecDict, _VarDict) ->
{t_any(), []};
-t_from_form({var, _L, Name}, _TypeNames, _RecDict, VarDict) ->
+t_from_form({var, _L, Name}, _TypeNames, _InOpaque, _RecDict, VarDict) ->
case dict:find(Name, VarDict) of
error -> {t_var(Name), []};
{ok, Val} -> {Val, []}
end;
-t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, RecDict, VarDict) ->
- t_from_form(Type, TypeNames, RecDict, VarDict);
-t_from_form({paren_type, _L, [Type]}, TypeNames, RecDict, VarDict) ->
- t_from_form(Type, TypeNames, RecDict, VarDict);
+t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, InOpaque, RecDict,
+ VarDict) ->
+ t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict);
+t_from_form({paren_type, _L, [Type]}, TypeNames, InOpaque, RecDict,
+ VarDict) ->
+ t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict);
t_from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]},
- TypeNames, RecDict, VarDict) ->
- {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict),
+ TypeNames, InOpaque, RecDict, VarDict) ->
+ {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict),
{t_remote(Module, Type, L), R};
-t_from_form({atom, _L, Atom}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({atom, _L, Atom}, _TypeNames, _InOpaque, _RecDict, _VarDict) ->
{t_atom(Atom), []};
-t_from_form({integer, _L, Int}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({integer, _L, Int}, _TypeNames, _InOpaque, _RecDict, _VarDict) ->
{t_integer(Int), []};
-t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
case erl_eval:partial_eval(Op) of
{integer, _, Val} ->
{t_integer(Val), []};
- _ -> throw({error, io_lib:format("Unable evaluate type ~w\n", [Op])})
+ _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])})
end;
-t_from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _TypeNames, _InOpaque,
+ _RecDict, _VarDict) ->
case erl_eval:partial_eval(Op) of
{integer, _, Val} ->
{t_integer(Val), []};
- _ -> throw({error, io_lib:format("Unable evaluate type ~w\n", [Op])})
+ _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])})
end;
-t_from_form({type, _L, any, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, any, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_any(), []};
-t_from_form({type, _L, arity, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, arity, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_arity(), []};
-t_from_form({type, _L, array, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, array, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_array(), []};
-t_from_form({type, _L, atom, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, atom, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_atom(), []};
-t_from_form({type, _L, binary, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, binary, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_binary(), []};
t_from_form({type, _L, binary, [Base, Unit]} = Type,
- _TypeNames, _RecDict, _VarDict) ->
+ _TypeNames, _InOpaque, _RecDict, _VarDict) ->
case {erl_eval:partial_eval(Base), erl_eval:partial_eval(Unit)} of
{{integer, _, BaseVal},
{integer, _, UnitVal}}
when BaseVal >= 0, UnitVal >= 0 ->
{t_bitstr(UnitVal, BaseVal), []};
- _ -> throw({error, io_lib:format("Unable evaluate type ~w\n", [Type])})
+ _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])})
end;
-t_from_form({type, _L, bitstring, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, bitstring, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_bitstr(), []};
-t_from_form({type, _L, bool, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, bool, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_boolean(), []}; % XXX: Temporarily
-t_from_form({type, _L, boolean, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, boolean, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_boolean(), []};
-t_from_form({type, _L, byte, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, byte, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_byte(), []};
-t_from_form({type, _L, char, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, char, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_char(), []};
-t_from_form({type, _L, dict, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, dict, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_dict(), []};
-t_from_form({type, _L, digraph, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, digraph, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_digraph(), []};
-t_from_form({type, _L, float, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, float, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_float(), []};
-t_from_form({type, _L, function, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, function, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_fun(), []};
-t_from_form({type, _L, 'fun', []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, 'fun', []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_fun(), []};
t_from_form({type, _L, 'fun', [{type, _, any, []}, Range]}, TypeNames,
- RecDict, VarDict) ->
- {T, R} = t_from_form(Range, TypeNames, RecDict, VarDict),
+ InOpaque, RecDict, VarDict) ->
+ {T, R} = t_from_form(Range, TypeNames, InOpaque, RecDict, VarDict),
{t_fun(T), R};
t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]},
- TypeNames, RecDict, VarDict) ->
- {L, R1} = list_from_form(Domain, TypeNames, RecDict, VarDict),
- {T, R2} = t_from_form(Range, TypeNames, RecDict, VarDict),
+ TypeNames, InOpaque, RecDict, VarDict) ->
+ {L, R1} = list_from_form(Domain, TypeNames, InOpaque, RecDict, VarDict),
+ {T, R2} = t_from_form(Range, TypeNames, InOpaque, RecDict, VarDict),
{t_fun(L, T), R1 ++ R2};
-t_from_form({type, _L, gb_set, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, gb_set, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_gb_set(), []};
-t_from_form({type, _L, gb_tree, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, gb_tree, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_gb_tree(), []};
-t_from_form({type, _L, identifier, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, identifier, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_identifier(), []};
-t_from_form({type, _L, integer, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, integer, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_integer(), []};
-t_from_form({type, _L, iodata, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, iodata, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_iodata(), []};
-t_from_form({type, _L, iolist, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, iolist, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_iolist(), []};
-t_from_form({type, _L, list, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, list, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_list(), []};
-t_from_form({type, _L, list, [Type]}, TypeNames, RecDict, VarDict) ->
- {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict),
+t_from_form({type, _L, list, [Type]}, TypeNames, InOpaque, RecDict,
+ VarDict) ->
+ {T, R} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict),
{t_list(T), R};
-t_from_form({type, _L, mfa, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, mfa, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_mfa(), []};
-t_from_form({type, _L, module, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, module, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_module(), []};
-t_from_form({type, _L, nil, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, nil, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_nil(), []};
-t_from_form({type, _L, neg_integer, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, neg_integer, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_neg_integer(), []};
-t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_non_neg_integer(), []};
-t_from_form({type, _L, no_return, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, no_return, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_unit(), []};
-t_from_form({type, _L, node, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, node, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_node(), []};
-t_from_form({type, _L, none, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, none, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_none(), []};
-t_from_form({type, _L, nonempty_list, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, nonempty_list, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_nonempty_list(), []};
-t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, RecDict, VarDict) ->
- {T, R} = t_from_form(Type, TypeNames, RecDict, VarDict),
+t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, InOpaque, RecDict,
+ VarDict) ->
+ {T, R} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict),
{t_nonempty_list(T), R};
t_from_form({type, _L, nonempty_improper_list, [Cont, Term]}, TypeNames,
- RecDict, VarDict) ->
- {T1, R1} = t_from_form(Cont, TypeNames, RecDict, VarDict),
- {T2, R2} = t_from_form(Term, TypeNames, RecDict, VarDict),
+ InOpaque, RecDict, VarDict) ->
+ {T1, R1} = t_from_form(Cont, TypeNames, InOpaque, RecDict, VarDict),
+ {T2, R2} = t_from_form(Term, TypeNames, InOpaque, RecDict, VarDict),
{t_cons(T1, T2), R1 ++ R2};
t_from_form({type, _L, nonempty_maybe_improper_list, []}, _TypeNames,
- _RecDict, _VarDict) ->
+ _InOpaque, _RecDict, _VarDict) ->
{t_cons(?any, ?any), []};
-t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]}, TypeNames,
- RecDict, VarDict) ->
- {T1, R1} = t_from_form(Cont, TypeNames, RecDict, VarDict),
- {T2, R2} = t_from_form(Term, TypeNames, RecDict, VarDict),
+t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]},
+ TypeNames, InOpaque, RecDict, VarDict) ->
+ {T1, R1} = t_from_form(Cont, TypeNames, InOpaque, RecDict, VarDict),
+ {T2, R2} = t_from_form(Term, TypeNames, InOpaque, RecDict, VarDict),
{t_cons(T1, T2), R1 ++ R2};
-t_from_form({type, _L, nonempty_string, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, nonempty_string, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_nonempty_string(), []};
-t_from_form({type, _L, number, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, number, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_number(), []};
-t_from_form({type, _L, pid, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, pid, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_pid(), []};
-t_from_form({type, _L, port, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, port, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_port(), []};
-t_from_form({type, _L, pos_integer, []}, _TypeNames, _RecDict, _VarDict) ->
- {t_pos_integer(), []};
-t_from_form({type, _L, maybe_improper_list, []}, _TypeNames, _RecDict,
+t_from_form({type, _L, pos_integer, []}, _TypeNames, _InOpaque, _RecDict,
_VarDict) ->
+ {t_pos_integer(), []};
+t_from_form({type, _L, maybe_improper_list, []}, _TypeNames, _InOpaque,
+ _RecDict, _VarDict) ->
{t_maybe_improper_list(), []};
-t_from_form({type, _L, maybe_improper_list, [Content, Termination]}, TypeNames,
- RecDict, VarDict) ->
- {T1, R1} = t_from_form(Content, TypeNames, RecDict, VarDict),
- {T2, R2} = t_from_form(Termination, TypeNames, RecDict, VarDict),
+t_from_form({type, _L, maybe_improper_list, [Content, Termination]},
+ TypeNames, InOpaque, RecDict, VarDict) ->
+ {T1, R1} = t_from_form(Content, TypeNames, InOpaque, RecDict, VarDict),
+ {T2, R2} = t_from_form(Termination, TypeNames, InOpaque, RecDict, VarDict),
{t_maybe_improper_list(T1, T2), R1 ++ R2};
-t_from_form({type, _L, product, Elements}, TypeNames, RecDict, VarDict) ->
- {L, R} = list_from_form(Elements, TypeNames, RecDict, VarDict),
+t_from_form({type, _L, product, Elements}, TypeNames, InOpaque, RecDict,
+ VarDict) ->
+ {L, R} = list_from_form(Elements, TypeNames, InOpaque, RecDict, VarDict),
{t_product(L), R};
-t_from_form({type, _L, queue, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, queue, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_queue(), []};
t_from_form({type, _L, range, [From, To]} = Type,
- _TypeNames, _RecDict, _VarDict) ->
+ _TypeNames, _InOpaque, _RecDict, _VarDict) ->
case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of
- {{integer, _, FromVal},
- {integer, _, ToVal}} ->
+ {{integer, _, FromVal}, {integer, _, ToVal}} ->
{t_from_range(FromVal, ToVal), []};
- _ -> throw({error, io_lib:format("Unable evaluate type ~w\n", [Type])})
+ _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])})
end;
-t_from_form({type, _L, record, [Name|Fields]}, TypeNames, RecDict, VarDict) ->
- record_from_form(Name, Fields, TypeNames, RecDict, VarDict);
-t_from_form({type, _L, reference, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, record, [Name|Fields]}, TypeNames, InOpaque, RecDict,
+ VarDict) ->
+ record_from_form(Name, Fields, TypeNames, InOpaque, RecDict, VarDict);
+t_from_form({type, _L, reference, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_reference(), []};
-t_from_form({type, _L, set, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, set, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_set(), []};
-t_from_form({type, _L, string, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, string, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_string(), []};
-t_from_form({type, _L, term, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, term, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_any(), []};
-t_from_form({type, _L, tid, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, tid, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_tid(), []};
-t_from_form({type, _L, timeout, []}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, timeout, []}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_timeout(), []};
-t_from_form({type, _L, tuple, any}, _TypeNames, _RecDict, _VarDict) ->
+t_from_form({type, _L, tuple, any}, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{t_tuple(), []};
-t_from_form({type, _L, tuple, Args}, TypeNames, RecDict, VarDict) ->
- {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict),
+t_from_form({type, _L, tuple, Args}, TypeNames, InOpaque, RecDict, VarDict) ->
+ {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict),
{t_tuple(L), R};
-t_from_form({type, _L, union, Args}, TypeNames, RecDict, VarDict) ->
- {L, R} = list_from_form(Args, TypeNames, RecDict, VarDict),
+t_from_form({type, _L, union, Args}, TypeNames, InOpaque, RecDict, VarDict) ->
+ {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict),
{t_sup(L), R};
-t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) ->
+t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) ->
case lookup_type(Name, RecDict) of
{type, {_Module, Type, ArgNames}} when length(Args) =:= length(ArgNames) ->
case unfold({type, Name}, TypeNames) of
@@ -3588,13 +3639,14 @@ t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) ->
List = lists:zipwith(
fun(ArgName, ArgType) ->
{Ttemp, _R} = t_from_form(ArgType, TypeNames,
- RecDict, VarDict),
+ InOpaque, RecDict,
+ VarDict),
{ArgName, Ttemp}
end,
ArgNames, Args),
TmpVarDict = dict:from_list(List),
- {T, R} = t_from_form(Type, [{type, Name}|TypeNames], RecDict,
- TmpVarDict),
+ {T, R} = t_from_form(Type, [{type, Name}|TypeNames], InOpaque,
+ RecDict, TmpVarDict),
case lists:member({type, Name}, R) of
true -> {t_limit(T, ?REC_TYPE_LIMIT), R};
false -> {T, R}
@@ -3607,22 +3659,28 @@ t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) ->
true ->
List = lists:zipwith(
fun(ArgName, ArgType) ->
- {Ttemp, _R} = t_from_form(ArgType, TypeNames,
- RecDict, VarDict),
+ {Ttemp, _R} = t_from_form(ArgType, TypeNames,
+ InOpaque, RecDict,
+ VarDict),
{ArgName, Ttemp}
end,
ArgNames, Args),
TmpVarDict = dict:from_list(List),
- {T, R} = t_from_form(Type, [{opaque, Name}|TypeNames], RecDict,
- TmpVarDict),
+ {T, R} = t_from_form(Type, [{opaque, Name}|TypeNames], true,
+ RecDict, TmpVarDict),
case lists:member({opaque, Name}, R) of
true -> {t_limit(T, ?REC_TYPE_LIMIT), R};
false -> {T, R}
end;
false -> {t_any(), [{opaque, Name}]}
end,
- Tret = t_from_form({opaque, -1, Name, {Module, Args, Rep}},
- RecDict, VarDict),
+ Tret =
+ case InOpaque of
+ true -> Rep;
+ false ->
+ t_from_form({opaque, -1, Name, {Module, Args, Rep}},
+ RecDict, VarDict)
+ end,
{Tret, Rret};
{type, _} ->
throw({error, io_lib:format("Unknown type ~w\n", [Name])});
@@ -3631,14 +3689,15 @@ t_from_form({type, _L, Name, Args}, TypeNames, RecDict, VarDict) ->
error ->
throw({error, io_lib:format("Unable to find type ~w\n", [Name])})
end;
-t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _RecDict,
- _VarDict) ->
+t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _InOpaque,
+ _RecDict, _VarDict) ->
case Args of
[] -> {t_opaque(Mod, Name, Args, Rep), []};
_ -> throw({error, "Polymorphic opaque types not supported yet"})
end.
-record_from_form({atom, _, Name}, ModFields, TypeNames, RecDict, VarDict) ->
+record_from_form({atom, _, Name}, ModFields, TypeNames, InOpaque, RecDict,
+ VarDict) ->
case unfold({record, Name}, TypeNames) of
true ->
case lookup_record(Name, RecDict) of
@@ -3649,11 +3708,12 @@ record_from_form({atom, _, Name}, ModFields, TypeNames, RecDict, VarDict) ->
{DeclFields1, R1} =
case lists:all(fun(Elem) -> Elem end, AreTyped) of
true -> {DeclFields, []};
- false -> fields_from_form(DeclFields, TypeNames1,
+ false -> fields_from_form(DeclFields, TypeNames1, InOpaque,
RecDict, dict:new())
end,
{GetModRec, R2} = get_mod_record(ModFields, DeclFields1,
- TypeNames1, RecDict, VarDict),
+ TypeNames1, InOpaque,
+ RecDict, VarDict),
case GetModRec of
{error, FieldName} ->
throw({error, io_lib:format("Illegal declaration of ~w#{~w}\n",
@@ -3670,11 +3730,13 @@ record_from_form({atom, _, Name}, ModFields, TypeNames, RecDict, VarDict) ->
false -> {t_any(), []}
end.
-get_mod_record([], DeclFields, _TypeNames, _RecDict, _VarDict) ->
+get_mod_record([], DeclFields, _TypeNames, _InOpaque, _RecDict,
+ _VarDict) ->
{{ok, DeclFields}, []};
-get_mod_record(ModFields, DeclFields, TypeNames, RecDict, VarDict) ->
+get_mod_record(ModFields, DeclFields, TypeNames, InOpaque, RecDict,
+ VarDict) ->
DeclFieldsDict = orddict:from_list(DeclFields),
- {ModFieldsDict, R} = build_field_dict(ModFields, TypeNames,
+ {ModFieldsDict, R} = build_field_dict(ModFields, TypeNames, InOpaque,
RecDict, VarDict),
case get_mod_record(DeclFieldsDict, ModFieldsDict, []) of
{error, _FieldName} = Error -> {Error, R};
@@ -3684,21 +3746,23 @@ get_mod_record(ModFields, DeclFields, TypeNames, RecDict, VarDict) ->
R}
end.
-build_field_dict(FieldTypes, TypeNames, RecDict, VarDict) ->
- build_field_dict(FieldTypes, TypeNames, RecDict, VarDict, []).
+build_field_dict(FieldTypes, TypeNames, InOpaque, RecDict, VarDict) ->
+ build_field_dict(FieldTypes, TypeNames, InOpaque, RecDict, VarDict, []).
build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left],
- TypeNames, RecDict, VarDict, Acc) ->
- {T, R1} = t_from_form(Type, TypeNames, RecDict, VarDict),
+ TypeNames, InOpaque, RecDict, VarDict, Acc) ->
+ {T, R1} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict),
NewAcc = [{Name, T}|Acc],
- {D, R2} = build_field_dict(Left, TypeNames, RecDict, VarDict, NewAcc),
+ {D, R2} = build_field_dict(Left, TypeNames, InOpaque, RecDict, VarDict,
+ NewAcc),
{D, R1 ++ R2};
-build_field_dict([], _TypeNames, _RecDict, _VarDict, Acc) ->
+build_field_dict([], _TypeNames, _InOpaque, _RecDict, _VarDict, Acc) ->
{orddict:from_list(Acc), []}.
get_mod_record([{FieldName, DeclType}|Left1],
[{FieldName, ModType}|Left2], Acc) ->
- case t_is_var(ModType) orelse t_is_subtype(ModType, DeclType) of
+ case t_is_var(ModType) orelse t_is_remote(ModType) orelse
+ t_is_subtype(ModType, DeclType) of
false -> {error, FieldName};
true -> get_mod_record(Left1, Left2, [{FieldName, ModType}|Acc])
end;
@@ -3711,18 +3775,19 @@ get_mod_record(DeclFields, [], Acc) ->
get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) ->
{error, FieldName2}.
-fields_from_form([], _TypeNames, _RecDict, _VarDict) ->
+fields_from_form([], _TypeNames, _InOpaque, _RecDict, _VarDict) ->
{[], []};
-fields_from_form([{Name, Type}|Tail], TypeNames, RecDict, VarDict) ->
- {T, R1} = t_from_form(Type, TypeNames, RecDict, VarDict),
- {F, R2} = fields_from_form(Tail, TypeNames, RecDict, VarDict),
+fields_from_form([{Name, Type}|Tail], TypeNames, InOpaque, RecDict,
+ VarDict) ->
+ {T, R1} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict),
+ {F, R2} = fields_from_form(Tail, TypeNames, InOpaque, RecDict, VarDict),
{[{Name, T}|F], R1 ++ R2}.
-list_from_form([], _TypeNames, _RecDict, _VarDict) ->
+list_from_form([], _TypeNames, _InOpaque, _RecDict, _VarDict) ->
{[], []};
-list_from_form([H|Tail], TypeNames, RecDict, VarDict) ->
- {T, R1} = t_from_form(H, TypeNames, RecDict, VarDict),
- {L, R2} = list_from_form(Tail, TypeNames, RecDict, VarDict),
+list_from_form([H|Tail], TypeNames, InOpaque, RecDict, VarDict) ->
+ {T, R1} = t_from_form(H, TypeNames, InOpaque, RecDict, VarDict),
+ {L, R2} = list_from_form(Tail, TypeNames, InOpaque, RecDict, VarDict),
{[T|L], R1 ++ R2}.
-spec t_form_to_string(parse_form()) -> string().
diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl
index 1f8be4040e..920c94d85c 100644
--- a/lib/hipe/icode/hipe_beam_to_icode.erl
+++ b/lib/hipe/icode/hipe_beam_to_icode.erl
@@ -369,6 +369,10 @@ trans_fun([{bif,BifName,{f,Lbl},[_] = Args,Reg}|Instructions], Env) ->
trans_fun([{bif,BifName,{f,Lbl},[_,_] = Args,Reg}|Instructions], Env) ->
{BifInsts,Env1} = trans_bif(2,BifName,Lbl,Args,Reg,Env),
[hipe_icode:mk_comment({bif2,BifName})|BifInsts] ++ trans_fun(Instructions,Env1);
+%%--- bif3 ---
+trans_fun([{bif,BifName,{f,Lbl},[_,_,_] = Args,Reg}|Instructions], Env) ->
+ {BifInsts,Env1} = trans_bif(3,BifName,Lbl,Args,Reg,Env),
+ [hipe_icode:mk_comment({bif3,BifName})|BifInsts] ++ trans_fun(Instructions,Env1);
%%--- allocate
trans_fun([{allocate,StackSlots,_}|Instructions], Env) ->
trans_allocate(StackSlots) ++ trans_fun(Instructions,Env);
diff --git a/lib/hipe/icode/hipe_icode_type.erl b/lib/hipe/icode/hipe_icode_type.erl
index 28198467f7..3f9488d7c3 100644
--- a/lib/hipe/icode/hipe_icode_type.erl
+++ b/lib/hipe/icode/hipe_icode_type.erl
@@ -2,19 +2,19 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
-%%
+%% Copyright Ericsson AB 2003-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%%%--------------------------------------------------------------------
@@ -23,8 +23,6 @@
%%% Description : Propagate type information.
%%%
%%% Created : 25 Feb 2003 by Tobias Lindahl <[email protected]>
-%%%
-%%% $Id$
%%%--------------------------------------------------------------------
-module(hipe_icode_type).
@@ -78,7 +76,7 @@
%-define(server_debug, fun(X, Y) -> io:format("~p server: ~s ~p~n", [self(), X, Y]) end).
-define(server_debug, fun(_, _) -> ok end).
--import(erl_types, [min/2, max/2, number_min/1, number_max/1,
+-import(erl_types, [number_min/1, number_max/1,
t_any/0, t_atom/1, t_atom/0, t_atom_vals/1,
t_binary/0, t_bitstr/0, t_bitstr_base/1, t_bitstr_unit/1,
t_boolean/0, t_cons/0, t_constant/0,
@@ -494,10 +492,10 @@ integer_range_less_then_propagator(IntArg1, IntArg2) ->
Min2 = number_min(IntArg2),
Max2 = number_max(IntArg2),
%% is this the same as erl_types:t_subtract?? no ... ??
- TrueMax1 = min(Max1, erl_bif_types:infinity_add(Max2, -1)),
- TrueMin2 = max(erl_bif_types:infinity_add(Min1, 1), Min2),
- FalseMin1 = max(Min1, Min2),
- FalseMax2 = min(Max1, Max2),
+ TrueMax1 = erl_types:min(Max1, erl_bif_types:infinity_add(Max2, -1)),
+ TrueMin2 = erl_types:max(erl_bif_types:infinity_add(Min1, 1), Min2),
+ FalseMin1 = erl_types:max(Min1, Min2),
+ FalseMax2 = erl_types:min(Max1, Max2),
{t_from_range(Min1, TrueMax1),
t_from_range(TrueMin2, Max2),
t_from_range(FalseMin1, Max1),
diff --git a/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl b/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl
index ac555b933c..ce33af453a 100644
--- a/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl
+++ b/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl
@@ -389,23 +389,23 @@ decrement_each([N|Ns], OldLow, IG, Vis, K) ->
%% {Spilled_node, Low_degree_neighbors, New_interference_graph}
spill(IG, Vis, Spill, K, SpillLimit, Target) ->
- Ns = list_ig(IG),
- Costs = spill_costs(Ns, IG, Vis, Spill, SpillLimit, Target),
- ?report3("spill costs are ~p~n",[Costs]),
- ActualCosts = lists:sort(Costs),
- ?report3("actual costs are ~p~n",[ActualCosts]),
+ Ns = list_ig(IG),
+ Costs = spill_costs(Ns, IG, Vis, Spill, SpillLimit, Target),
+ ?report3("spill costs are ~p~n", [Costs]),
+ ActualCosts = lists:sort(Costs),
+ ?report3("actual costs are ~p~n", [ActualCosts]),
case ActualCosts of
- [] ->
- ?error_msg("There is no node to spill",[]),
+ [] ->
+ ?error_msg("There is no node to spill", []),
?EXIT('no node to spill');
[{_Cost,N}|_] ->
{Low, NewIG} = decrement_neighbors(N, [], IG, Vis, K),
- %?report("spilled node ~p at cost ~p (~p now ready)~n",[N,Cost,Low]),
+ %% ?report("spilled node ~p at cost ~p (~p now ready)~n", [N,Cost,Low]),
{N, Low, NewIG}
end.
spill_costs([], _IG, _Vis, _Spill, _SpillLimit, _Target) ->
- [];
+ [];
spill_costs([{N,Info}|Ns], IG, Vis, Spill, SpillLimit, Target) ->
case degree(Info) of
0 -> spill_costs(Ns,IG,Vis,Spill, SpillLimit, Target);
@@ -451,28 +451,28 @@ select_colors([{X,colorable}|Xs], IG, Cols, PhysRegs, K) ->
{Reg,NewCols} = select_color(X, IG, Cols, PhysRegs),
?report("~p~n",[Reg]),
[{X,{reg,Reg}} | select_colors(Xs, IG, NewCols, PhysRegs, K)];
-%select_colors([{X,{spill,M}}|Xs], IG, Cols, PhysRegs, K) ->
-% ?report('spilled: ~p~n',[X]),
-% %% Check if optimistic coloring could have found a color
-% case catch select_color(X,IG,Cols,K) of
-% {'EXIT',_} -> % no color possible
-% ?report('(no optimistic color)~n',[]),
-% [{X,{spill,M}}|select_colors(Xs, IG, Cols, PhysRegs, K)];
-% {Reg,NewCols} ->
-% ?report('(optimistic color: ~p)~n',[Reg]),
-% [{X,{reg,Reg}}|select_colors(Xs, IG, Cols, PhysRegs, K)]
-% end.
+%%select_colors([{X,{spill,M}}|Xs], IG, Cols, PhysRegs, K) ->
+%% ?report('spilled: ~p~n',[X]),
+%% %% Check if optimistic coloring could have found a color
+%% case catch select_color(X,IG,Cols,K) of
+%% {'EXIT',_} -> % no color possible
+%% ?report('(no optimistic color)~n',[]),
+%% [{X,{spill,M}}|select_colors(Xs, IG, Cols, PhysRegs, K)];
+%% {Reg,NewCols} ->
+%% ?report('(optimistic color: ~p)~n',[Reg]),
+%% [{X,{reg,Reg}}|select_colors(Xs, IG, Cols, PhysRegs, K)]
+%% end.
%% Old code / pessimistic coloring:
select_colors([{X,{spill,M}}|Xs], IG, Cols, PhysRegs, K) ->
?report("spilled: ~p~n",[X]),
%% Check if optimistic coloring could have found a color
-% case catch select_color(X,IG,Cols,K) of
-% {'EXIT',_} -> % no color possible
-% ?report('(no optimistic color)~n',[]);
-% {Reg,NewCols} ->
-% ?report('(optimistic color: ~p)~n',[Reg])
-% end,
+%% case catch select_color(X,IG,Cols,K) of
+%% {'EXIT',_} -> % no color possible
+%% ?report('(no optimistic color)~n',[]);
+%% {Reg,NewCols} ->
+%% ?report('(optimistic color: ~p)~n',[Reg])
+%% end,
[{X,{spill,M}} | select_colors(Xs, IG, Cols, PhysRegs, K)].
select_color(X, IG, Cols, PhysRegs) ->
diff --git a/lib/hipe/x86/hipe_x86_spill_restore.erl b/lib/hipe/x86/hipe_x86_spill_restore.erl
index e60c446e17..cd927669fb 100644
--- a/lib/hipe/x86/hipe_x86_spill_restore.erl
+++ b/lib/hipe/x86/hipe_x86_spill_restore.erl
@@ -1,20 +1,20 @@
%% -*- erlang-indent-level: 2 -*-
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2008-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% ====================================================================
@@ -71,9 +71,9 @@ firstPass(Defun) ->
case hipe_x86_cfg:reverse_postorder(CFG0) of
[Label1, Label2|_] ->
SaveTreeElement = saveTreeLookup(Label2, SaveTree),
- %% FilteredSaveTreeElement is the to be spilled temps around the function call.
- %% They are spilled just before move formals
- FilteredSaveTreeElement = [Temp || Temp <- SaveTreeElement, temp_is_pseudo(Temp)],
+ %% FilteredSaveTreeElement is the to be spilled temps around the
+ %% function call. They are spilled just before move formals.
+ FilteredSaveTreeElement = [T || T <- SaveTreeElement, temp_is_pseudo(T)],
Block = hipe_x86_cfg:bb(CFG1, Label1),
Code = hipe_bb:code(Block),
%% The following statements are tedious but work ok.
@@ -83,7 +83,7 @@ firstPass(Defun) ->
%% Another solution may be to introduce another block.
MoveCodes = lists:sublist(Code, length(Code)-1),
JumpCode = lists:last(Code),
- hipe_x86_cfg:bb_add(CFG1, Label1, hipe_bb:mk_bb(MoveCodes ++ [hipe_x86:mk_pseudo_spill(FilteredSaveTreeElement)] ++ [JumpCode]));
+ hipe_x86_cfg:bb_add(CFG1, Label1, hipe_bb:mk_bb(MoveCodes ++ [hipe_x86:mk_pseudo_spill(FilteredSaveTreeElement), JumpCode]));
_ ->
CFG1
end.
@@ -110,13 +110,12 @@ firstPassHelper([Label|Labels], Liveness, CFG, SaveTree) ->
NewBlock = hipe_bb:code_update(Block, NewCode),
NewCFG = hipe_x86_cfg:bb_add(CFG, Label, NewBlock),
SizeOfSet = setSize(NewIntersectedList),
-
%% if the Intersected Save List is not empty, insert it in the save tree.
if SizeOfSet =/= 0 ->
- UpdatedSaveTree = gb_trees:insert(Label,NewIntersectedList,SaveTree),
- firstPassHelper(Labels, Liveness, NewCFG,UpdatedSaveTree);
+ UpdatedSaveTree = gb_trees:insert(Label, NewIntersectedList, SaveTree),
+ firstPassHelper(Labels, Liveness, NewCFG, UpdatedSaveTree);
true ->
- firstPassHelper(Labels, Liveness, NewCFG,SaveTree)
+ firstPassHelper(Labels, Liveness, NewCFG, SaveTree)
end;
firstPassHelper([], _, CFG, SaveTree) ->
{CFG, SaveTree}.
@@ -125,17 +124,15 @@ firstPassHelper([], _, CFG, SaveTree) ->
firstPassDoBlock(Insts, LiveOut, IntersectedSaveList) ->
lists:foldr(fun firstPassDoInsn/2, {LiveOut,IntersectedSaveList,[]}, Insts).
-firstPassDoInsn(I, {LiveOut,IntersectedSaveList,PrevInsts} ) ->
+firstPassDoInsn(I, {LiveOut,IntersectedSaveList,PrevInsts}) ->
case I of
#pseudo_call{} ->
do_pseudo_call(I, {LiveOut,IntersectedSaveList,PrevInsts});
_ -> % other instructions
DefinedList = from_list( ?HIPE_X86_LIVENESS:defines(I)),
UsedList = from_list(?HIPE_X86_LIVENESS:uses(I)),
-
NewLiveOut = subtract(union(LiveOut, UsedList), DefinedList),
- NewIntersectedSaveList = subtract(IntersectedSaveList, DefinedList),
-
+ NewIntersectedSaveList = subtract(IntersectedSaveList, DefinedList),
{NewLiveOut, NewIntersectedSaveList, [I|PrevInsts]}
end.
@@ -162,7 +159,7 @@ saveTreeLookup(Label, SaveTree) ->
[]
end.
-%% Performs the second pass of the algoritm.
+%% Performs the second pass of the algorithm.
%% It basically eliminates the unnecessary spills and introduces restores.
%% Works top down
secondPass(CFG0) ->
@@ -306,7 +303,8 @@ addRestoreBlockToEdge(PseudoCall, ContLabel, CFG, TempArgsList) ->
NewCFG = hipe_x86_cfg:bb_add(CFG, NextLabel, NewBlock),
{NewCFG, NewPseudoCall}.
-%% used instead of hipe_x86_cfg:redirect_jmp since it does not handle pseudo_call calls.
+%% used instead of hipe_x86_cfg:redirect_jmp since it does not handle
+%% pseudo_call calls.
redirect_pseudo_call(I = #pseudo_call{contlab=ContLabel}, Old, New) ->
case Old =:= ContLabel of
true -> I#pseudo_call{contlab=New};
@@ -323,8 +321,8 @@ temp_is_pseudo(Temp) ->
%% Set operations where the module name is an easily changeable macro
%%---------------------------------------------------------------------
-union(Set1,Set2) ->
- ?SET_MODULE:union(Set1,Set2).
+union(Set1, Set2) ->
+ ?SET_MODULE:union(Set1, Set2).
setSize(Set) ->
?SET_MODULE:size(Set).
diff --git a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java
index 4146bd3ced..a9712aa2ba 100644
--- a/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java
+++ b/lib/jinterface/java_src/com/ericsson/otp/erlang/OtpMbox.java
@@ -678,6 +678,11 @@ public class OtpMbox {
return m.self.equals(self);
}
+ @Override
+ public int hashCode() {
+ return self.hashCode();
+ }
+
/*
* called by OtpNode to deliver message to this mailbox.
*
diff --git a/lib/kernel/doc/src/notes.xml b/lib/kernel/doc/src/notes.xml
index 9859183390..edd6ea52b0 100644
--- a/lib/kernel/doc/src/notes.xml
+++ b/lib/kernel/doc/src/notes.xml
@@ -30,6 +30,29 @@
</header>
<p>This document describes the changes made to the Kernel application.</p>
+<section><title>Kernel 2.14.1.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>In embedded mode, on_load handlers that called
+ <c>code:priv_dir/1</c> or other functions in <c>code</c>
+ would hang the system. Since the <c>crypto</c>
+ application now contains an on_loader handler that calls
+ <c>code:priv_dir/1</c>, including the <c>crypto</c>
+ application in the boot file would prevent the system
+ from starting.</p>
+ <p>Also extended the <c>-init_debug</c> option to print
+ information about on_load handlers being run to
+ facilitate debugging.</p>
+ <p>
+ Own Id: OTP-8902 Aux Id: seq11703 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Kernel 2.14.1</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/kernel/src/kernel.erl b/lib/kernel/src/kernel.erl
index 92ee7b441a..1e07620a3e 100644
--- a/lib/kernel/src/kernel.erl
+++ b/lib/kernel/src/kernel.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -143,6 +143,13 @@ init(safe) ->
Boot = start_boot_server(),
DiskLog = start_disk_log(),
Pg2 = start_pg2(),
+
+ %% Run the on_load handlers for all modules that have been
+ %% loaded so far. Running them at this point means that
+ %% on_load handlers can safely call kernel processes
+ %% (and in particular call code:priv_dir/1 or code:lib_dir/1).
+ init:run_on_load_handlers(),
+
{ok, {SupFlags, Boot ++ DiskLog ++ Pg2}}.
get_code_args() ->
diff --git a/lib/kernel/test/code_SUITE_data/on_load_app-1.0/src/on_load_embedded.erl b/lib/kernel/test/code_SUITE_data/on_load_app-1.0/src/on_load_embedded.erl
index a39332f81d..b7fdd4d9ae 100644
--- a/lib/kernel/test/code_SUITE_data/on_load_app-1.0/src/on_load_embedded.erl
+++ b/lib/kernel/test/code_SUITE_data/on_load_app-1.0/src/on_load_embedded.erl
@@ -3,6 +3,15 @@
-on_load(run_me/0).
run_me() ->
+ %% An onload handler typically calls code:priv_dir/1
+ %% or code:lib_dir/1, so make sure that it works.
+ LibDir = code:lib_dir(on_load_app),
+ PrivDir = code:priv_dir(on_load_app),
+ LibDir = filename:dirname(PrivDir),
+ ModPath = code:which(?MODULE),
+ LibDir = filename:dirname(filename:dirname(ModPath)),
+
+ %% Start a process to remember that the on_load was called.
spawn(fun() ->
register(everything_is_fine, self()),
receive Any ->
diff --git a/lib/kernel/vsn.mk b/lib/kernel/vsn.mk
index 651d082379..03fe63e385 100644
--- a/lib/kernel/vsn.mk
+++ b/lib/kernel/vsn.mk
@@ -1 +1 @@
-KERNEL_VSN = 2.14.1
+KERNEL_VSN = 2.14.2
diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl
index 0298b382a6..021be8af2a 100644
--- a/lib/mnesia/src/mnesia_controller.erl
+++ b/lib/mnesia/src/mnesia_controller.erl
@@ -98,6 +98,8 @@
connect_nodes2/3
]).
+-compile({no_auto_import,[error/2]}).
+
-import(mnesia_lib, [set/2, add/2]).
-import(mnesia_lib, [fatal/2, error/2, verbose/2, dbg_out/2]).
diff --git a/lib/mnesia/src/mnesia_locker.erl b/lib/mnesia/src/mnesia_locker.erl
index cfa3f171b2..6b5770d91e 100644
--- a/lib/mnesia/src/mnesia_locker.erl
+++ b/lib/mnesia/src/mnesia_locker.erl
@@ -49,6 +49,8 @@
system_code_change/4
]).
+-compile({no_auto_import,[error/2]}).
+
-include("mnesia.hrl").
-import(mnesia_lib, [dbg_out/2, error/2, verbose/2]).
diff --git a/lib/mnesia/src/mnesia_log.erl b/lib/mnesia/src/mnesia_log.erl
index 00ec4740ee..11b792026e 100644
--- a/lib/mnesia/src/mnesia_log.erl
+++ b/lib/mnesia/src/mnesia_log.erl
@@ -182,6 +182,8 @@
]).
+-compile({no_auto_import,[error/2]}).
+
-include("mnesia.hrl").
-import(mnesia_lib, [val/1, dir/1]).
-import(mnesia_lib, [exists/1, fatal/2, error/2, dbg_out/2]).
diff --git a/lib/mnesia/src/mnesia_monitor.erl b/lib/mnesia/src/mnesia_monitor.erl
index 5bd93d6b9b..b6eda9ad3a 100644
--- a/lib/mnesia/src/mnesia_monitor.erl
+++ b/lib/mnesia/src/mnesia_monitor.erl
@@ -70,6 +70,8 @@
negotiate_protocol_impl/2
]).
+-compile({no_auto_import,[error/2]}).
+
-import(mnesia_lib, [dbg_out/2, verbose/2, error/2, fatal/2, set/2]).
-include("mnesia.hrl").
diff --git a/lib/mnesia/src/mnesia_recover.erl b/lib/mnesia/src/mnesia_recover.erl
index 0ca7bf3f7f..7435b6896a 100644
--- a/lib/mnesia/src/mnesia_recover.erl
+++ b/lib/mnesia/src/mnesia_recover.erl
@@ -62,6 +62,7 @@
code_change/3
]).
+-compile({no_auto_import,[error/2]}).
-include("mnesia.hrl").
-import(mnesia_lib, [set/2, verbose/2, error/2, fatal/2]).
diff --git a/lib/mnesia/src/mnesia_subscr.erl b/lib/mnesia/src/mnesia_subscr.erl
index 93d4a86f7f..415c69d508 100644
--- a/lib/mnesia/src/mnesia_subscr.erl
+++ b/lib/mnesia/src/mnesia_subscr.erl
@@ -43,6 +43,8 @@
code_change/3
]).
+-compile({no_auto_import,[error/2]}).
+
-include("mnesia.hrl").
-import(mnesia_lib, [error/2]).
diff --git a/lib/observer/src/Makefile b/lib/observer/src/Makefile
index dde1ea17be..b4eb518dd7 100644
--- a/lib/observer/src/Makefile
+++ b/lib/observer/src/Makefile
@@ -111,7 +111,8 @@ release_spec: opt
$(INSTALL_DIR) $(RELSYSDIR)/src
$(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR)/src
$(INSTALL_DATA) $(INTERNAL_HRL_FILES) $(RELSYSDIR)/src
- $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/src
+ $(INSTALL_DIR) $(RELSYSDIR)/examples
+ $(INSTALL_DATA) $(EXAMPLE_FILES) $(RELSYSDIR)/examples
$(INSTALL_DIR) $(RELSYSDIR)/include
$(INSTALL_DATA) $(HRL_FILES) $(RELSYSDIR)/include
$(INSTALL_DIR) $(RELSYSDIR)/ebin
diff --git a/lib/public_key/asn1/OTP-PKIX.asn1 b/lib/public_key/asn1/OTP-PKIX.asn1
index c0cf440496..ad704191a9 100644
--- a/lib/public_key/asn1/OTP-PKIX.asn1
+++ b/lib/public_key/asn1/OTP-PKIX.asn1
@@ -302,18 +302,25 @@ SupportedPublicKeyAlgorithms PUBLIC-KEY-ALGORITHM-CLASS ::= {
-- DSA Keys and Signatures
+
+ DSAParams ::= CHOICE
+ {
+ params Dss-Parms,
+ null NULL
+ }
+
-- SubjectPublicKeyInfo:
dsa PUBLIC-KEY-ALGORITHM-CLASS ::= {
ID id-dsa
- TYPE Dss-Parms -- XXX Must be OPTIONAL
+ TYPE DSAParams -- XXX Must be OPTIONAL
PUBLIC-KEY-TYPE DSAPublicKey }
-- Certificate.signatureAlgorithm
dsa-with-sha1 SIGNATURE-ALGORITHM-CLASS ::= {
- ID id-dsa-with-sha1
- TYPE Dss-Parms }
+ ID id-dsa-with-sha1
+ TYPE DSAParams }
--
-- RSA Keys and Signatures
diff --git a/lib/public_key/doc/src/notes.xml b/lib/public_key/doc/src/notes.xml
index ca32063624..6e7381eb18 100644
--- a/lib/public_key/doc/src/notes.xml
+++ b/lib/public_key/doc/src/notes.xml
@@ -1,11 +1,11 @@
-<?xml version="1.0" encoding="latin1" ?>
+<?xml version="1.0" encoding="iso-8859-1" ?>
<!DOCTYPE chapter SYSTEM "chapter.dtd">
<chapter>
<header>
<copyright>
<year>2008</year>
- <year>2008</year>
+ <year>2010</year>
<holder>Ericsson AB, All Rights Reserved</holder>
</copyright>
<legalnotice>
diff --git a/lib/public_key/src/pubkey_cert.erl b/lib/public_key/src/pubkey_cert.erl
index 570f44e530..c467e24741 100644
--- a/lib/public_key/src/pubkey_cert.erl
+++ b/lib/public_key/src/pubkey_cert.erl
@@ -318,7 +318,7 @@ verify_fun(Otpcert, Result, UserState0, VerifyFun) ->
{extension, #'Extension'{critical = true}} ->
throw({bad_cert, unknown_critical_extension});
_ ->
- UserState
+ UserState
end
end.
@@ -394,10 +394,12 @@ public_key_info(PublicKeyInfo,
NewPublicKeyParams =
case PublicKeyParams of
- 'NULL' when WorkingAlgorithm == Algorithm ->
+ {null, 'NULL'} when WorkingAlgorithm == Algorithm ->
WorkingParams;
- _ ->
- PublicKeyParams
+ {params, Params} ->
+ Params;
+ Params ->
+ Params
end,
{Algorithm, PublicKey, NewPublicKeyParams}.
diff --git a/lib/public_key/src/public_key.erl b/lib/public_key/src/public_key.erl
index d514b9a3aa..095a6ff0e0 100644
--- a/lib/public_key/src/public_key.erl
+++ b/lib/public_key/src/public_key.erl
@@ -528,7 +528,6 @@ path_validation([DerCert | _] = Path,
{error, Reason}
end.
-
validate(DerCert, #path_validation_state{working_issuer_name = Issuer,
working_public_key = Key,
working_public_key_parameters =
diff --git a/lib/public_key/test/erl_make_certs.erl b/lib/public_key/test/erl_make_certs.erl
index e31e5552d3..8b01ca3ad4 100644
--- a/lib/public_key/test/erl_make_certs.erl
+++ b/lib/public_key/test/erl_make_certs.erl
@@ -66,7 +66,7 @@ make_cert(Opts) ->
%% @end
%%--------------------------------------------------------------------
write_pem(Dir, FileName, {Cert, Key = {_,_,not_encrypted}}) when is_binary(Cert) ->
- ok = der_to_pem(filename:join(Dir, FileName ++ ".pem"),
+ ok = der_to_pem(filename:join(Dir, FileName ++ ".pem"),
[{'Certificate', Cert, not_encrypted}]),
ok = der_to_pem(filename:join(Dir, FileName ++ "_key.pem"), [Key]).
@@ -268,7 +268,7 @@ publickey(#'RSAPrivateKey'{modulus=N, publicExponent=E}) ->
subjectPublicKey = Public};
publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) ->
Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa',
- parameters=#'Dss-Parms'{p=P, q=Q, g=G}},
+ parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}},
#'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}.
validity(Opts) ->
@@ -290,7 +290,7 @@ sign_algorithm(#'RSAPrivateKey'{}, Opts) ->
end,
{Type, 'NULL'};
sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) ->
- {?'id-dsa-with-sha1', #'Dss-Parms'{p=P, q=Q, g=G}}.
+ {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}.
make_key(rsa, _Opts) ->
%% (OBS: for testing only)
diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml
index 413703deca..511f1e0bb2 100644
--- a/lib/ssl/doc/src/ssl.xml
+++ b/lib/ssl/doc/src/ssl.xml
@@ -114,7 +114,7 @@
<p><c>ciphersuite() =
{key_exchange(), cipher(), hash()}</c></p>
- <p><c>key_exchange() = rsa | dhe_dss | dhe_rsa
+ <p><c>key_exchange() = rsa | dhe_dss | dhe_rsa | dh_anon
</c></p>
<p><c>cipher() = rc4_128 | des_cbc | '3des_ede_cbc'
@@ -170,8 +170,13 @@
<tag>{ciphers, ciphers()}</tag>
<item>The cipher suites that should be supported. The function
- <c>ciphers_suites/0</c> can be used to find all available
- ciphers.
+ <c>cipher_suites/0</c> can be used to find all available
+ ciphers. Additionally some anonymous cipher suites ({dh_anon,
+ rc4_128, md5}, {dh_anon, des_cbc, sha}, {dh_anon,
+ '3des_ede_cbc', sha}, {dh_anon, aes_128_cbc, sha}, {dh_anon,
+ aes_256_cbc, sha}) are supported for testing purposes and will
+ only work if explicitly enabled by this option and they are supported/enabled
+ by the peer also.
</item>
<tag>{ssl_imp, ssl_imp()}</tag>
diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl
index b4437628c3..7e5929d708 100644
--- a/lib/ssl/src/ssl.erl
+++ b/lib/ssl/src/ssl.erl
@@ -190,7 +190,8 @@ transport_accept(#sslsocket{} = ListenSocket, Timeout) ->
%%--------------------------------------------------------------------
-spec ssl_accept(#sslsocket{}) -> {ok, #sslsocket{}} | {error, reason()}.
--spec ssl_accept(#sslsocket{}, timeout()) -> {ok, #sslsocket{}} | {error, reason()}.
+-spec ssl_accept(#sslsocket{}, list() | timeout()) -> {ok, #sslsocket{}} | {error, reason()}.
+-spec ssl_accept(port(), list(), timeout()) -> {ok, #sslsocket{}} | {error, reason()}.
%%
%% Description: Performs accept on a ssl listen socket. e.i. performs
%% ssl handshake.
@@ -463,11 +464,102 @@ versions() ->
%%---------------------------------------------------------------
-spec renegotiate(#sslsocket{}) -> ok | {error, reason()}.
%%
-%% Description:
+%% Description: Initiates a renegotiation.
%%--------------------------------------------------------------------
renegotiate(#sslsocket{pid = Pid, fd = new_ssl}) ->
ssl_connection:renegotiation(Pid).
+%%---------------------------------------------------------------
+-spec format_error({error, term()}) -> list().
+%%
+%% Description: Creates error string.
+%%--------------------------------------------------------------------
+format_error({error, Reason}) ->
+ format_error(Reason);
+format_error(Reason) when is_list(Reason) ->
+ Reason;
+format_error(closed) ->
+ "The connection is closed";
+format_error(ecacertfile) ->
+ "Own CA certificate file is invalid.";
+format_error(ecertfile) ->
+ "Own certificate file is invalid.";
+format_error(ekeyfile) ->
+ "Own private key file is invalid.";
+format_error(esslaccept) ->
+ "Server SSL handshake procedure between client and server failed.";
+format_error(esslconnect) ->
+ "Client SSL handshake procedure between client and server failed.";
+format_error({eoptions, Options}) ->
+ lists:flatten(io_lib:format("Error in options list: ~p~n", [Options]));
+
+%%%%%%%%%%%% START OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+format_error(ebadsocket) ->
+ "Connection not found (internal error).";
+format_error(ebadstate) ->
+ "Connection not in connect state (internal error).";
+format_error(ebrokertype) ->
+ "Wrong broker type (internal error).";
+format_error(echaintoolong) ->
+ "The chain of certificates provided by peer is too long.";
+format_error(ecipher) ->
+ "Own list of specified ciphers is invalid.";
+format_error(ekeymismatch) ->
+ "Own private key does not match own certificate.";
+format_error(enoissuercert) ->
+ "Cannot find certificate of issuer of certificate provided by peer.";
+format_error(enoservercert) ->
+ "Attempt to do accept without having set own certificate.";
+format_error(enotlistener) ->
+ "Attempt to accept on a non-listening socket.";
+format_error(enoproxysocket) ->
+ "No proxy socket found (internal error or max number of file "
+ "descriptors exceeded).";
+format_error(enooptions) ->
+ "List of options is empty.";
+format_error(enotstarted) ->
+ "The SSL application has not been started.";
+format_error(eoptions) ->
+ "Invalid list of options.";
+format_error(epeercert) ->
+ "Certificate provided by peer is in error.";
+format_error(epeercertexpired) ->
+ "Certificate provided by peer has expired.";
+format_error(epeercertinvalid) ->
+ "Certificate provided by peer is invalid.";
+format_error(eselfsignedcert) ->
+ "Certificate provided by peer is self signed.";
+format_error(esslerrssl) ->
+ "SSL protocol failure. Typically because of a fatal alert from peer.";
+format_error(ewantconnect) ->
+ "Protocol wants to connect, which is not supported in this "
+ "version of the SSL application.";
+format_error(ex509lookup) ->
+ "Protocol wants X.509 lookup, which is not supported in this "
+ "version of the SSL application.";
+format_error({badcall, _Call}) ->
+ "Call not recognized for current mode (active or passive) and state "
+ "of socket.";
+format_error({badcast, _Cast}) ->
+ "Call not recognized for current mode (active or passive) and state "
+ "of socket.";
+
+format_error({badinfo, _Info}) ->
+ "Call not recognized for current mode (active or passive) and state "
+ "of socket.";
+
+%%%%%%%%%%%%%%%%%% END OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+format_error(Error) ->
+ case (catch inet:format_error(Error)) of
+ "unkknown POSIX" ++ _ ->
+ no_format(Error);
+ {'EXIT', _} ->
+ no_format(Error);
+ Other ->
+ Other
+ end.
+
%%%--------------------------------------------------------------
%%% Internal functions
%%%--------------------------------------------------------------------
@@ -655,7 +747,7 @@ validate_option(depth, Value) when is_integer(Value),
validate_option(cert, Value) when Value == undefined;
is_binary(Value) ->
Value;
-validate_option(certfile, Value) when is_list(Value) ->
+validate_option(certfile, Value) when Value == undefined; is_list(Value) ->
Value;
validate_option(key, undefined) ->
@@ -798,7 +890,7 @@ cipher_suites(Version, [{_,_,_}| _] = Ciphers0) ->
Ciphers = [ssl_cipher:suite(C) || C <- Ciphers0],
cipher_suites(Version, Ciphers);
cipher_suites(Version, [Cipher0 | _] = Ciphers0) when is_binary(Cipher0) ->
- Supported = ssl_cipher:suites(Version),
+ Supported = ssl_cipher:suites(Version) ++ ssl_cipher:anonymous_suites(),
case [Cipher || Cipher <- Ciphers0, lists:member(Cipher, Supported)] of
[] ->
Supported;
@@ -814,92 +906,6 @@ cipher_suites(Version, Ciphers0) ->
Ciphers = [ssl_cipher:openssl_suite(C) || C <- string:tokens(Ciphers0, ":")],
cipher_suites(Version, Ciphers).
-format_error({error, Reason}) ->
- format_error(Reason);
-format_error(Reason) when is_list(Reason) ->
- Reason;
-format_error(closed) ->
- "The connection is closed";
-format_error(ecacertfile) ->
- "Own CA certificate file is invalid.";
-format_error(ecertfile) ->
- "Own certificate file is invalid.";
-format_error(ekeyfile) ->
- "Own private key file is invalid.";
-format_error(esslaccept) ->
- "Server SSL handshake procedure between client and server failed.";
-format_error(esslconnect) ->
- "Client SSL handshake procedure between client and server failed.";
-format_error({eoptions, Options}) ->
- lists:flatten(io_lib:format("Error in options list: ~p~n", [Options]));
-
-%%%%%%%%%%%% START OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-format_error(ebadsocket) ->
- "Connection not found (internal error).";
-format_error(ebadstate) ->
- "Connection not in connect state (internal error).";
-format_error(ebrokertype) ->
- "Wrong broker type (internal error).";
-format_error(echaintoolong) ->
- "The chain of certificates provided by peer is too long.";
-format_error(ecipher) ->
- "Own list of specified ciphers is invalid.";
-format_error(ekeymismatch) ->
- "Own private key does not match own certificate.";
-format_error(enoissuercert) ->
- "Cannot find certificate of issuer of certificate provided by peer.";
-format_error(enoservercert) ->
- "Attempt to do accept without having set own certificate.";
-format_error(enotlistener) ->
- "Attempt to accept on a non-listening socket.";
-format_error(enoproxysocket) ->
- "No proxy socket found (internal error or max number of file "
- "descriptors exceeded).";
-format_error(enooptions) ->
- "List of options is empty.";
-format_error(enotstarted) ->
- "The SSL application has not been started.";
-format_error(eoptions) ->
- "Invalid list of options.";
-format_error(epeercert) ->
- "Certificate provided by peer is in error.";
-format_error(epeercertexpired) ->
- "Certificate provided by peer has expired.";
-format_error(epeercertinvalid) ->
- "Certificate provided by peer is invalid.";
-format_error(eselfsignedcert) ->
- "Certificate provided by peer is self signed.";
-format_error(esslerrssl) ->
- "SSL protocol failure. Typically because of a fatal alert from peer.";
-format_error(ewantconnect) ->
- "Protocol wants to connect, which is not supported in this "
- "version of the SSL application.";
-format_error(ex509lookup) ->
- "Protocol wants X.509 lookup, which is not supported in this "
- "version of the SSL application.";
-format_error({badcall, _Call}) ->
- "Call not recognized for current mode (active or passive) and state "
- "of socket.";
-format_error({badcast, _Cast}) ->
- "Call not recognized for current mode (active or passive) and state "
- "of socket.";
-
-format_error({badinfo, _Info}) ->
- "Call not recognized for current mode (active or passive) and state "
- "of socket.";
-
-%%%%%%%%%%%%%%%%%% END OLD SSL format_error %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-format_error(Error) ->
- case (catch inet:format_error(Error)) of
- "unkknown POSIX" ++ _ ->
- no_format(Error);
- {'EXIT', _} ->
- no_format(Error);
- Other ->
- Other
- end.
-
no_format(Error) ->
lists:flatten(io_lib:format("No format string for error: \"~p\" available.", [Error])).
diff --git a/lib/ssl/src/ssl_certificate.erl b/lib/ssl/src/ssl_certificate.erl
index a4c54afb27..5571fb01f6 100644
--- a/lib/ssl/src/ssl_certificate.erl
+++ b/lib/ssl/src/ssl_certificate.erl
@@ -112,9 +112,10 @@ file_to_certificats(File) ->
{ok, List} = ssl_manager:cache_pem_file(File),
[Bin || {'Certificate', Bin, not_encrypted} <- List].
%%--------------------------------------------------------------------
--spec validate_extension(term(), #'Extension'{}, term()) -> {valid, term()} |
- {fail, tuple()} |
- {unknown, term()}.
+-spec validate_extension(term(), #'Extension'{} | {bad_cert, atom()} | valid,
+ term()) -> {valid, term()} |
+ {fail, tuple()} |
+ {unknown, term()}.
%%
%% Description: Validates ssl/tls specific extensions
%%--------------------------------------------------------------------
diff --git a/lib/ssl/src/ssl_certificate_db.erl b/lib/ssl/src/ssl_certificate_db.erl
index 7d50c30d47..2a5a7f3394 100644
--- a/lib/ssl/src/ssl_certificate_db.erl
+++ b/lib/ssl/src/ssl_certificate_db.erl
@@ -228,4 +228,3 @@ add_certs(Cert, Ref, CertsDb) ->
"it could not be correctly decoded.~n", []),
error_logger:info_report(Report)
end.
-
diff --git a/lib/ssl/src/ssl_cipher.erl b/lib/ssl/src/ssl_cipher.erl
index 8230149304..9824e17fcd 100644
--- a/lib/ssl/src/ssl_cipher.erl
+++ b/lib/ssl/src/ssl_cipher.erl
@@ -34,7 +34,7 @@
-export([security_parameters/2, suite_definition/1,
decipher/5, cipher/4,
- suite/1, suites/1,
+ suite/1, suites/1, anonymous_suites/0,
openssl_suite/1, openssl_suite_name/1, filter/2]).
-compile(inline).
@@ -191,6 +191,19 @@ suites({3, N}) when N == 1; N == 2 ->
ssl_tls1:suites().
%%--------------------------------------------------------------------
+-spec anonymous_suites() -> [cipher_suite()].
+%%
+%% Description: Returns a list of the anonymous cipher suites, only supported
+%% if explicitly set by user. Intended only for testing.
+%%--------------------------------------------------------------------
+anonymous_suites() ->
+ [?TLS_DH_anon_WITH_RC4_128_MD5,
+ ?TLS_DH_anon_WITH_DES_CBC_SHA,
+ ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA,
+ ?TLS_DH_anon_WITH_AES_128_CBC_SHA,
+ ?TLS_DH_anon_WITH_AES_256_CBC_SHA].
+
+%%--------------------------------------------------------------------
-spec suite_definition(cipher_suite()) -> erl_cipher_suite().
%%
%% Description: Return erlang cipher suite definition.
@@ -235,7 +248,20 @@ suite_definition(?TLS_RSA_WITH_AES_256_CBC_SHA) ->
suite_definition(?TLS_DHE_DSS_WITH_AES_256_CBC_SHA) ->
{dhe_dss, aes_256_cbc, sha};
suite_definition(?TLS_DHE_RSA_WITH_AES_256_CBC_SHA) ->
- {dhe_rsa, aes_256_cbc, sha}.
+ {dhe_rsa, aes_256_cbc, sha};
+
+%%% DH-ANON deprecated by TLS spec and not available
+%%% by default, but good for testing purposes.
+suite_definition(?TLS_DH_anon_WITH_RC4_128_MD5) ->
+ {dh_anon, rc4_128, md5};
+suite_definition(?TLS_DH_anon_WITH_DES_CBC_SHA) ->
+ {dh_anon, des_cbc, sha};
+suite_definition(?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA) ->
+ {dh_anon, '3des_ede_cbc', sha};
+suite_definition(?TLS_DH_anon_WITH_AES_128_CBC_SHA) ->
+ {dh_anon, aes_128_cbc, sha};
+suite_definition(?TLS_DH_anon_WITH_AES_256_CBC_SHA) ->
+ {dh_anon, aes_256_cbc, sha}.
%%--------------------------------------------------------------------
-spec suite(erl_cipher_suite()) -> cipher_suite().
@@ -266,12 +292,12 @@ suite({dhe_rsa, des_cbc, sha}) ->
?TLS_DHE_RSA_WITH_DES_CBC_SHA;
suite({dhe_rsa, '3des_ede_cbc', sha}) ->
?TLS_DHE_RSA_WITH_3DES_EDE_CBC_SHA;
-%% suite({dh_anon, rc4_128, md5}) ->
-%% ?TLS_DH_anon_WITH_RC4_128_MD5;
-%% suite({dh_anon, des40_cbc, sha}) ->
-%% ?TLS_DH_anon_WITH_DES_CBC_SHA;
-%% suite({dh_anon, '3des_ede_cbc', sha}) ->
-%% ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA;
+suite({dh_anon, rc4_128, md5}) ->
+ ?TLS_DH_anon_WITH_RC4_128_MD5;
+suite({dh_anon, des_cbc, sha}) ->
+ ?TLS_DH_anon_WITH_DES_CBC_SHA;
+suite({dh_anon, '3des_ede_cbc', sha}) ->
+ ?TLS_DH_anon_WITH_3DES_EDE_CBC_SHA;
%%% TSL V1.1 AES suites
suite({rsa, aes_128_cbc, sha}) ->
@@ -280,16 +306,16 @@ suite({dhe_dss, aes_128_cbc, sha}) ->
?TLS_DHE_DSS_WITH_AES_128_CBC_SHA;
suite({dhe_rsa, aes_128_cbc, sha}) ->
?TLS_DHE_RSA_WITH_AES_128_CBC_SHA;
-%% suite({dh_anon, aes_128_cbc, sha}) ->
-%% ?TLS_DH_anon_WITH_AES_128_CBC_SHA;
+suite({dh_anon, aes_128_cbc, sha}) ->
+ ?TLS_DH_anon_WITH_AES_128_CBC_SHA;
suite({rsa, aes_256_cbc, sha}) ->
?TLS_RSA_WITH_AES_256_CBC_SHA;
suite({dhe_dss, aes_256_cbc, sha}) ->
?TLS_DHE_DSS_WITH_AES_256_CBC_SHA;
suite({dhe_rsa, aes_256_cbc, sha}) ->
- ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA.
-%% suite({dh_anon, aes_256_cbc, sha}) ->
-%% ?TLS_DH_anon_WITH_AES_256_CBC_SHA.
+ ?TLS_DHE_RSA_WITH_AES_256_CBC_SHA;
+suite({dh_anon, aes_256_cbc, sha}) ->
+ ?TLS_DH_anon_WITH_AES_256_CBC_SHA.
%%--------------------------------------------------------------------
-spec openssl_suite(openssl_cipher_suite()) -> cipher_suite().
@@ -580,5 +606,3 @@ filter_rsa_suites(Use, KeyUse, CipherSuits, RsaSuites) ->
false ->
CipherSuits -- RsaSuites
end.
-
-
diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl
index c3f16699a1..3a9cada81e 100644
--- a/lib/ssl/src/ssl_connection.erl
+++ b/lib/ssl/src/ssl_connection.erl
@@ -75,7 +75,7 @@
session, % #session{} from ssl_handshake.hrl
session_cache, %
session_cache_cb, %
- negotiated_version, % #protocol_version{}
+ negotiated_version, % tls_version()
supported_protocol_versions, % [atom()]
client_certificate_requested = false,
key_algorithm, % atom as defined by cipher_suite
@@ -374,7 +374,7 @@ hello(#server_hello{cipher_suite = CipherSuite,
case ssl_handshake:hello(Hello, SslOptions, ConnectionStates0, Renegotiation) of
{Version, NewId, ConnectionStates} ->
- {KeyAlgorithm, _, _} =
+ {KeyAlgorithm, _, _} =
ssl_cipher:suite_definition(CipherSuite),
PremasterSecret = make_premaster_secret(ReqVersion, KeyAlgorithm),
@@ -512,7 +512,7 @@ certify(#certificate{} = Cert,
certify(#server_key_exchange{} = KeyExchangeMsg,
#state{role = client, negotiated_version = Version,
key_algorithm = Alg} = State0)
- when Alg == dhe_dss; Alg == dhe_rsa ->
+ when Alg == dhe_dss; Alg == dhe_rsa; Alg == dh_anon ->
case handle_server_key(KeyExchangeMsg, State0) of
#state{} = State1 ->
{Record, State} = next_record(State1),
@@ -613,25 +613,10 @@ certify_client_key_exchange(#client_diffie_hellman_public{dh_public = ClientPubl
#state{negotiated_version = Version,
diffie_hellman_params = #'DHParameter'{prime = P,
base = G},
- diffie_hellman_keys = {_, ServerDhPrivateKey},
- role = Role,
- session = Session,
- connection_states = ConnectionStates0} = State0) ->
-
- PMpint = crypto:mpint(P),
- GMpint = crypto:mpint(G),
- PremasterSecret = crypto:dh_compute_key(mpint_binary(ClientPublicDhKey),
- ServerDhPrivateKey,
- [PMpint, GMpint]),
-
- case ssl_handshake:master_secret(Version, PremasterSecret,
- ConnectionStates0, Role) of
- {MasterSecret, ConnectionStates} ->
- State1 = State0#state{session =
- Session#session{master_secret
- = MasterSecret},
- connection_states = ConnectionStates},
+ diffie_hellman_keys = {_, ServerDhPrivateKey}} = State0) ->
+ case dh_master_secret(crypto:mpint(P), crypto:mpint(G), ClientPublicDhKey, ServerDhPrivateKey, State0) of
+ #state{} = State1 ->
{Record, State} = next_record(State1),
next_state(cipher, Record, State);
#alert{} = Alert ->
@@ -1056,6 +1041,8 @@ init_certificates(#ssl_options{cacerts = CaCerts,
end,
init_certificates(Cert, CertDbRef, CacheRef, CertFile, Role).
+init_certificates(undefined, CertDbRef, CacheRef, "", _) ->
+ {ok, CertDbRef, CacheRef, undefined};
init_certificates(undefined, CertDbRef, CacheRef, CertFile, client) ->
try
@@ -1066,18 +1053,18 @@ init_certificates(undefined, CertDbRef, CacheRef, CertFile, client) ->
end;
init_certificates(undefined, CertDbRef, CacheRef, CertFile, server) ->
- try
+ try
[OwnCert] = ssl_certificate:file_to_certificats(CertFile),
{ok, CertDbRef, CacheRef, OwnCert}
- catch
- Error:Reason ->
- handle_file_error(?LINE, Error, Reason, CertFile, ecertfile,
- erlang:get_stacktrace())
- end;
+ catch
+ Error:Reason ->
+ handle_file_error(?LINE, Error, Reason, CertFile, ecertfile,
+ erlang:get_stacktrace())
+ end;
init_certificates(Cert, CertDbRef, CacheRef, _, _) ->
{ok, CertDbRef, CacheRef, Cert}.
-init_private_key(undefined, "", _Password, client) ->
+init_private_key(undefined, "", _Password, _Client) ->
undefined;
init_private_key(undefined, KeyFile, Password, _) ->
try
@@ -1337,15 +1324,17 @@ server_hello_done(#state{transport_cb = Transport,
Transport:send(Socket, BinHelloDone),
State#state{connection_states = NewConnectionStates,
tls_handshake_hashes = NewHashes}.
-
-certify_server(#state{transport_cb = Transport,
- socket = Socket,
- negotiated_version = Version,
- connection_states = ConnectionStates,
- tls_handshake_hashes = Hashes,
- cert_db_ref = CertDbRef,
- own_cert = OwnCert} = State) ->
+certify_server(#state{key_algorithm = dh_anon} = State) ->
+ State;
+
+certify_server(#state{transport_cb = Transport,
+ socket = Socket,
+ negotiated_version = Version,
+ connection_states = ConnectionStates,
+ tls_handshake_hashes = Hashes,
+ cert_db_ref = CertDbRef,
+ own_cert = OwnCert} = State) ->
case ssl_handshake:certificate(OwnCert, CertDbRef, server) of
CertMsg = #certificate{} ->
{BinCertMsg, NewConnectionStates, NewHashes} =
@@ -1370,7 +1359,8 @@ key_exchange(#state{role = server, key_algorithm = Algo,
transport_cb = Transport
} = State)
when Algo == dhe_dss;
- Algo == dhe_rsa ->
+ Algo == dhe_rsa;
+ Algo == dh_anon ->
Keys = crypto:dh_generate_key([crypto:mpint(P), crypto:mpint(G)]),
ConnectionState =
@@ -1389,11 +1379,6 @@ key_exchange(#state{role = server, key_algorithm = Algo,
diffie_hellman_keys = Keys,
tls_handshake_hashes = Hashes1};
-
-%% key_algorithm = dh_anon is not supported. Should be by default disabled
-%% if support is implemented and then we need a key_exchange clause for it
-%% here.
-
key_exchange(#state{role = client,
connection_states = ConnectionStates0,
key_algorithm = rsa,
@@ -1416,7 +1401,8 @@ key_exchange(#state{role = client,
socket = Socket, transport_cb = Transport,
tls_handshake_hashes = Hashes0} = State)
when Algorithm == dhe_dss;
- Algorithm == dhe_rsa ->
+ Algorithm == dhe_rsa;
+ Algorithm == dh_anon ->
Msg = ssl_handshake:key_exchange(client, {dh, DhPubKey}),
{BinMsg, ConnectionStates1, Hashes1} =
encode_handshake(Msg, Version, ConnectionStates0, Hashes0),
@@ -1494,23 +1480,30 @@ save_verify_data(client, #finished{verify_data = Data}, ConnectionStates, abbrev
save_verify_data(server, #finished{verify_data = Data}, ConnectionStates, abbreviated) ->
ssl_record:set_server_verify_data(current_write, Data, ConnectionStates).
+handle_server_key(#server_key_exchange{params =
+ #server_dh_params{dh_p = P,
+ dh_g = G,
+ dh_y = ServerPublicDhKey},
+ signed_params = <<>>},
+ #state{key_algorithm = dh_anon} = State) ->
+ dh_master_secret(P, G, ServerPublicDhKey, undefined, State);
+
handle_server_key(
#server_key_exchange{params =
#server_dh_params{dh_p = P,
dh_g = G,
dh_y = ServerPublicDhKey},
signed_params = Signed},
- #state{session = Session, negotiated_version = Version, role = Role,
- public_key_info = PubKeyInfo,
+ #state{public_key_info = PubKeyInfo,
key_algorithm = KeyAlgo,
- connection_states = ConnectionStates0} = State) ->
+ connection_states = ConnectionStates} = State) ->
PLen = size(P),
GLen = size(G),
YLen = size(ServerPublicDhKey),
ConnectionState =
- ssl_record:pending_connection_state(ConnectionStates0, read),
+ ssl_record:pending_connection_state(ConnectionStates, read),
SecParams = ConnectionState#connection_state.security_parameters,
#security_parameters{client_random = ClientRandom,
server_random = ServerRandom} = SecParams,
@@ -1524,29 +1517,11 @@ handle_server_key(
case verify_dh_params(Signed, Hash, PubKeyInfo) of
true ->
- PMpint = mpint_binary(P),
- GMpint = mpint_binary(G),
- Keys = {_, ClientDhPrivateKey} =
- crypto:dh_generate_key([PMpint,GMpint]),
- PremasterSecret =
- crypto:dh_compute_key(mpint_binary(ServerPublicDhKey),
- ClientDhPrivateKey, [PMpint, GMpint]),
- case ssl_handshake:master_secret(Version, PremasterSecret,
- ConnectionStates0, Role) of
- {MasterSecret, ConnectionStates} ->
- State#state{diffie_hellman_keys = Keys,
- session =
- Session#session{master_secret
- = MasterSecret},
- connection_states = ConnectionStates};
- #alert{} = Alert ->
- Alert
- end;
+ dh_master_secret(P, G, ServerPublicDhKey, undefined, State);
false ->
?ALERT_REC(?FATAL,?HANDSHAKE_FAILURE)
end.
-
verify_dh_params(Signed, Hashes, {?rsaEncryption, PubKey, _PubKeyParams}) ->
case public_key:decrypt_public(Signed, PubKey,
[{rsa_pad, rsa_pkcs1_padding}]) of
@@ -1558,6 +1533,30 @@ verify_dh_params(Signed, Hashes, {?rsaEncryption, PubKey, _PubKeyParams}) ->
verify_dh_params(Signed, Hash, {?'id-dsa', PublicKey, PublicKeyParams}) ->
public_key:verify(Hash, none, Signed, {PublicKey, PublicKeyParams}).
+dh_master_secret(Prime, Base, PublicDhKey, undefined, State) ->
+ PMpint = mpint_binary(Prime),
+ GMpint = mpint_binary(Base),
+ Keys = {_, PrivateDhKey} =
+ crypto:dh_generate_key([PMpint,GMpint]),
+ dh_master_secret(PMpint, GMpint, PublicDhKey, PrivateDhKey, State#state{diffie_hellman_keys = Keys});
+
+dh_master_secret(PMpint, GMpint, PublicDhKey, PrivateDhKey,
+ #state{session = Session,
+ negotiated_version = Version, role = Role,
+ connection_states = ConnectionStates0} = State) ->
+ PremasterSecret =
+ crypto:dh_compute_key(mpint_binary(PublicDhKey), PrivateDhKey,
+ [PMpint, GMpint]),
+ case ssl_handshake:master_secret(Version, PremasterSecret,
+ ConnectionStates0, Role) of
+ {MasterSecret, ConnectionStates} ->
+ State#state{
+ session =
+ Session#session{master_secret = MasterSecret},
+ connection_states = ConnectionStates};
+ #alert{} = Alert ->
+ Alert
+ end.
cipher_role(client, Data, Session, #state{connection_states = ConnectionStates0} = State) ->
ConnectionStates = ssl_record:set_server_verify_data(current_both, Data, ConnectionStates0),
diff --git a/lib/ssl/src/ssl_handshake.erl b/lib/ssl/src/ssl_handshake.erl
index a6d39f0af1..f8e5d585e7 100644
--- a/lib/ssl/src/ssl_handshake.erl
+++ b/lib/ssl/src/ssl_handshake.erl
@@ -237,7 +237,7 @@ certificate(OwnCert, CertDbRef, client) ->
{error, _} ->
%% If no suitable certificate is available, the client
%% SHOULD send a certificate message containing no
- %% certificates. (chapter 7.4.6. rfc 4346)
+ %% certificates. (chapter 7.4.6. RFC 4346)
[]
end,
#certificate{asn1_certificates = Chain};
@@ -352,15 +352,22 @@ key_exchange(server, {dh, {<<?UINT32(Len), PublicKey:Len/binary>>, _},
YLen = byte_size(PublicKey),
ServerDHParams = #server_dh_params{dh_p = PBin,
dh_g = GBin, dh_y = PublicKey},
- Hash =
- server_key_exchange_hash(KeyAlgo, <<ClientRandom/binary,
- ServerRandom/binary,
- ?UINT16(PLen), PBin/binary,
- ?UINT16(GLen), GBin/binary,
- ?UINT16(YLen), PublicKey/binary>>),
- Signed = digitally_signed(Hash, PrivateKey),
- #server_key_exchange{params = ServerDHParams,
- signed_params = Signed}.
+
+ case KeyAlgo of
+ dh_anon ->
+ #server_key_exchange{params = ServerDHParams,
+ signed_params = <<>>};
+ _ ->
+ Hash =
+ server_key_exchange_hash(KeyAlgo, <<ClientRandom/binary,
+ ServerRandom/binary,
+ ?UINT16(PLen), PBin/binary,
+ ?UINT16(GLen), GBin/binary,
+ ?UINT16(YLen), PublicKey/binary>>),
+ Signed = digitally_signed(Hash, PrivateKey),
+ #server_key_exchange{params = ServerDHParams,
+ signed_params = Signed}
+ end.
%%--------------------------------------------------------------------
-spec master_secret(tls_version(), #session{} | binary(), #connection_states{},
@@ -470,6 +477,73 @@ decode_client_key(ClientKey, Type, Version) ->
dec_client_key(ClientKey, key_exchange_alg(Type), Version).
%%--------------------------------------------------------------------
+-spec init_hashes() ->{{binary(), binary()}, {binary(), binary()}}.
+
+%%
+%% Description: Calls crypto hash (md5 and sha) init functions to
+%% initalize the hash context.
+%%--------------------------------------------------------------------
+init_hashes() ->
+ T = {crypto:md5_init(), crypto:sha_init()},
+ {T, T}.
+
+%%--------------------------------------------------------------------
+-spec update_hashes({{binary(), binary()}, {binary(), binary()}}, Data ::term()) ->
+ {{binary(), binary()}, {binary(), binary()}}.
+%%
+%% Description: Calls crypto hash (md5 and sha) update functions to
+%% update the hash context with Data.
+%%--------------------------------------------------------------------
+update_hashes(Hashes, % special-case SSL2 client hello
+ <<?CLIENT_HELLO, ?UINT24(_), ?BYTE(Major), ?BYTE(Minor),
+ ?UINT16(CSLength), ?UINT16(0),
+ ?UINT16(CDLength),
+ CipherSuites:CSLength/binary,
+ ChallengeData:CDLength/binary>>) ->
+ update_hashes(Hashes,
+ <<?CLIENT_HELLO, ?BYTE(Major), ?BYTE(Minor),
+ ?UINT16(CSLength), ?UINT16(0),
+ ?UINT16(CDLength),
+ CipherSuites:CSLength/binary,
+ ChallengeData:CDLength/binary>>);
+update_hashes({{MD50, SHA0}, _Prev}, Data) ->
+ ?DBG_HEX(Data),
+ {MD51, SHA1} = {crypto:md5_update(MD50, Data),
+ crypto:sha_update(SHA0, Data)},
+ ?DBG_HEX(crypto:md5_final(MD51)),
+ ?DBG_HEX(crypto:sha_final(SHA1)),
+ {{MD51, SHA1}, {MD50, SHA0}}.
+
+%%--------------------------------------------------------------------
+-spec decrypt_premaster_secret(binary(), #'RSAPrivateKey'{}) -> binary().
+
+%%
+%% Description: Public key decryption using the private key.
+%%--------------------------------------------------------------------
+decrypt_premaster_secret(Secret, RSAPrivateKey) ->
+ try public_key:decrypt_private(Secret, RSAPrivateKey,
+ [{rsa_pad, rsa_pkcs1_padding}])
+ catch
+ _:_ ->
+ throw(?ALERT_REC(?FATAL, ?DECRYPTION_FAILED))
+ end.
+
+%%--------------------------------------------------------------------
+-spec server_key_exchange_hash(rsa | dhe_rsa| dhe_dss | dh_anon, binary()) -> binary().
+
+%%
+%% Description: Calculate server key exchange hash
+%%--------------------------------------------------------------------
+server_key_exchange_hash(Algorithm, Value) when Algorithm == rsa;
+ Algorithm == dhe_rsa ->
+ MD5 = crypto:md5(Value),
+ SHA = crypto:sha(Value),
+ <<MD5/binary, SHA/binary>>;
+
+server_key_exchange_hash(dhe_dss, Value) ->
+ crypto:sha(Value).
+
+%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
get_tls_handshake_aux(<<?BYTE(Type), ?UINT24(Length),
@@ -790,6 +864,13 @@ dec_hs(?CERTIFICATE, <<?UINT24(ACLen), ASN1Certs:ACLen/binary>>) ->
dec_hs(?SERVER_KEY_EXCHANGE, <<?UINT16(PLen), P:PLen/binary,
?UINT16(GLen), G:GLen/binary,
?UINT16(YLen), Y:YLen/binary,
+ ?UINT16(0)>>) -> %% May happen if key_algorithm is dh_anon
+ #server_key_exchange{params = #server_dh_params{dh_p = P,dh_g = G,
+ dh_y = Y},
+ signed_params = <<>>};
+dec_hs(?SERVER_KEY_EXCHANGE, <<?UINT16(PLen), P:PLen/binary,
+ ?UINT16(GLen), G:GLen/binary,
+ ?UINT16(YLen), Y:YLen/binary,
?UINT16(Len), Sig:Len/binary>>) ->
#server_key_exchange{params = #server_dh_params{dh_p = P,dh_g = G,
dh_y = Y},
@@ -857,14 +938,6 @@ encrypted_premaster_secret(Secret, RSAPublicKey) ->
throw(?ALERT_REC(?FATAL, ?HANDSHAKE_FAILURE))
end.
-decrypt_premaster_secret(Secret, RSAPrivateKey) ->
- try public_key:decrypt_private(Secret, RSAPrivateKey,
- [{rsa_pad, rsa_pkcs1_padding}])
- catch
- _:_ ->
- throw(?ALERT_REC(?FATAL, ?DECRYPTION_FAILED))
- end.
-
%% encode/decode stream of certificate data to/from list of certificate data
certs_to_list(ASN1Certs) ->
certs_to_list(ASN1Certs, []).
@@ -983,29 +1056,6 @@ enc_hello_extensions([#renegotiation_info{renegotiated_connection = Info} | Rest
Len = InfoLen +1,
enc_hello_extensions(Rest, <<?UINT16(?RENEGOTIATION_EXT), ?UINT16(Len), ?BYTE(InfoLen), Info/binary, Acc/binary>>).
-init_hashes() ->
- T = {crypto:md5_init(), crypto:sha_init()},
- {T, T}.
-
-update_hashes(Hashes, % special-case SSL2 client hello
- <<?CLIENT_HELLO, ?UINT24(_), ?BYTE(Major), ?BYTE(Minor),
- ?UINT16(CSLength), ?UINT16(0),
- ?UINT16(CDLength),
- CipherSuites:CSLength/binary,
- ChallengeData:CDLength/binary>>) ->
- update_hashes(Hashes,
- <<?CLIENT_HELLO, ?BYTE(Major), ?BYTE(Minor),
- ?UINT16(CSLength), ?UINT16(0),
- ?UINT16(CDLength),
- CipherSuites:CSLength/binary,
- ChallengeData:CDLength/binary>>);
-update_hashes({{MD50, SHA0}, _Prev}, Data) ->
- ?DBG_HEX(Data),
- {MD51, SHA1} = {crypto:md5_update(MD50, Data),
- crypto:sha_update(SHA0, Data)},
- ?DBG_HEX(crypto:md5_final(MD51)),
- ?DBG_HEX(crypto:sha_final(SHA1)),
- {{MD51, SHA1}, {MD50, SHA0}}.
from_3bytes(Bin3) ->
from_3bytes(Bin3, []).
@@ -1094,19 +1144,10 @@ calc_certificate_verify({3, N}, _, Algorithm, Hashes)
when N == 1; N == 2 ->
ssl_tls1:certificate_verify(Algorithm, Hashes).
-server_key_exchange_hash(Algorithm, Value) when Algorithm == rsa;
- Algorithm == dhe_rsa ->
- MD5 = crypto:md5(Value),
- SHA = crypto:sha(Value),
- <<MD5/binary, SHA/binary>>;
-
-server_key_exchange_hash(dhe_dss, Value) ->
- crypto:sha(Value).
-
key_exchange_alg(rsa) ->
?KEY_EXCHANGE_RSA;
key_exchange_alg(Alg) when Alg == dhe_rsa; Alg == dhe_dss;
- Alg == dh_dss; Alg == dh_rsa ->
+ Alg == dh_dss; Alg == dh_rsa; Alg == dh_anon ->
?KEY_EXCHANGE_DIFFIE_HELLMAN;
key_exchange_alg(_) ->
?NULL.
diff --git a/lib/ssl/src/ssl_internal.hrl b/lib/ssl/src/ssl_internal.hrl
index ddb05e70f6..d2dee4d861 100644
--- a/lib/ssl/src/ssl_internal.hrl
+++ b/lib/ssl/src/ssl_internal.hrl
@@ -104,7 +104,7 @@
-type tls_atom_version() :: sslv3 | tlsv1.
-type cache_ref() :: term().
-type certdb_ref() :: term().
--type key_algo() :: null | rsa | dhe_rsa | dhe_dss.
+-type key_algo() :: null | rsa | dhe_rsa | dhe_dss | dh_anon.
-type enum_algo() :: integer().
-type public_key() :: #'RSAPublicKey'{} | integer().
-type public_key_params() :: #'Dss-Parms'{} | term().
diff --git a/lib/ssl/src/ssl_manager.erl b/lib/ssl/src/ssl_manager.erl
index 0116466677..3b02d96562 100644
--- a/lib/ssl/src/ssl_manager.erl
+++ b/lib/ssl/src/ssl_manager.erl
@@ -122,6 +122,7 @@ server_session_id(Port, SuggestedSessionId, SslOpts) ->
call({server_session_id, Port, SuggestedSessionId, SslOpts}).
%%--------------------------------------------------------------------
+-spec register_session(port_num(), #session{}) -> ok.
-spec register_session(host(), port_num(), #session{}) -> ok.
%%
%% Description: Make the session available for reuse.
@@ -132,6 +133,7 @@ register_session(Host, Port, Session) ->
register_session(Port, Session) ->
cast({register_session, Port, Session}).
%%--------------------------------------------------------------------
+-spec invalidate_session(port_num(), #session{}) -> ok.
-spec invalidate_session(host(), port_num(), #session{}) -> ok.
%%
%% Description: Make the session unavilable for reuse.
diff --git a/lib/ssl/src/ssl_record.erl b/lib/ssl/src/ssl_record.erl
index acd0d49c19..803baeb09c 100644
--- a/lib/ssl/src/ssl_record.erl
+++ b/lib/ssl/src/ssl_record.erl
@@ -497,6 +497,66 @@ decode_cipher_text(CipherText, ConnnectionStates0) ->
#alert{} = Alert ->
Alert
end.
+%%--------------------------------------------------------------------
+-spec encode_data(iolist(), tls_version(), #connection_states{}, integer()) ->
+ {iolist(), iolist(), #connection_states{}}.
+%%
+%% Description: Encodes data to send on the ssl-socket.
+%%--------------------------------------------------------------------
+encode_data(Frag, Version, ConnectionStates, RenegotiateAt)
+ when byte_size(Frag) < (?MAX_PLAIN_TEXT_LENGTH - 2048) ->
+ case encode_plain_text(?APPLICATION_DATA,Version,Frag,ConnectionStates, RenegotiateAt) of
+ {renegotiate, Data} ->
+ {[], Data, ConnectionStates};
+ {Msg, CS} ->
+ {Msg, [], CS}
+ end;
+
+encode_data(Frag, Version, ConnectionStates, RenegotiateAt) when is_binary(Frag) ->
+ Data = split_bin(Frag, ?MAX_PLAIN_TEXT_LENGTH - 2048),
+ encode_data(Data, Version, ConnectionStates, RenegotiateAt);
+
+encode_data(Data, Version, ConnectionStates0, RenegotiateAt) when is_list(Data) ->
+ {ConnectionStates, EncodedMsg, NotEncdedData} =
+ lists:foldl(fun(B, {CS0, Encoded, Rest}) ->
+ case encode_plain_text(?APPLICATION_DATA,
+ Version, B, CS0, RenegotiateAt) of
+ {renegotiate, NotEnc} ->
+ {CS0, Encoded, [NotEnc | Rest]};
+ {Enc, CS1} ->
+ {CS1, [Enc | Encoded], Rest}
+ end
+ end, {ConnectionStates0, [], []}, Data),
+ {lists:reverse(EncodedMsg), lists:reverse(NotEncdedData), ConnectionStates}.
+
+%%--------------------------------------------------------------------
+-spec encode_handshake(iolist(), tls_version(), #connection_states{}) ->
+ {iolist(), #connection_states{}}.
+%%
+%% Description: Encodes a handshake message to send on the ssl-socket.
+%%--------------------------------------------------------------------
+encode_handshake(Frag, Version, ConnectionStates) ->
+ encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates).
+
+%%--------------------------------------------------------------------
+-spec encode_alert_record(#alert{}, tls_version(), #connection_states{}) ->
+ {iolist(), #connection_states{}}.
+%%
+%% Description: Encodes an alert message to send on the ssl-socket.
+%%--------------------------------------------------------------------
+encode_alert_record(#alert{level = Level, description = Description},
+ Version, ConnectionStates) ->
+ encode_plain_text(?ALERT, Version, <<?BYTE(Level), ?BYTE(Description)>>,
+ ConnectionStates).
+
+%%--------------------------------------------------------------------
+-spec encode_change_cipher_spec(tls_version(), #connection_states{}) ->
+ {iolist(), #connection_states{}}.
+%%
+%% Description: Encodes a change_cipher_spec-message to send on the ssl socket.
+%%--------------------------------------------------------------------
+encode_change_cipher_spec(Version, ConnectionStates) ->
+ encode_plain_text(?CHANGE_CIPHER_SPEC, Version, <<1:8>>, ConnectionStates).
%%--------------------------------------------------------------------
%%% Internal functions
@@ -550,43 +610,6 @@ split_bin(Bin, ChunkSize, Acc) ->
lists:reverse(Acc, [Bin])
end.
-encode_data(Frag, Version, ConnectionStates, RenegotiateAt)
- when byte_size(Frag) < (?MAX_PLAIN_TEXT_LENGTH - 2048) ->
- case encode_plain_text(?APPLICATION_DATA,Version,Frag,ConnectionStates, RenegotiateAt) of
- {renegotiate, Data} ->
- {[], Data, ConnectionStates};
- {Msg, CS} ->
- {Msg, [], CS}
- end;
-
-encode_data(Frag, Version, ConnectionStates, RenegotiateAt) when is_binary(Frag) ->
- Data = split_bin(Frag, ?MAX_PLAIN_TEXT_LENGTH - 2048),
- encode_data(Data, Version, ConnectionStates, RenegotiateAt);
-
-encode_data(Data, Version, ConnectionStates0, RenegotiateAt) when is_list(Data) ->
- {ConnectionStates, EncodedMsg, NotEncdedData} =
- lists:foldl(fun(B, {CS0, Encoded, Rest}) ->
- case encode_plain_text(?APPLICATION_DATA,
- Version, B, CS0, RenegotiateAt) of
- {renegotiate, NotEnc} ->
- {CS0, Encoded, [NotEnc | Rest]};
- {Enc, CS1} ->
- {CS1, [Enc | Encoded], Rest}
- end
- end, {ConnectionStates0, [], []}, Data),
- {lists:reverse(EncodedMsg), lists:reverse(NotEncdedData), ConnectionStates}.
-
-encode_handshake(Frag, Version, ConnectionStates) ->
- encode_plain_text(?HANDSHAKE, Version, Frag, ConnectionStates).
-
-encode_alert_record(#alert{level = Level, description = Description},
- Version, ConnectionStates) ->
- encode_plain_text(?ALERT, Version, <<?BYTE(Level), ?BYTE(Description)>>,
- ConnectionStates).
-
-encode_change_cipher_spec(Version, ConnectionStates) ->
- encode_plain_text(?CHANGE_CIPHER_SPEC, Version, <<1:8>>, ConnectionStates).
-
encode_plain_text(Type, Version, Data, ConnectionStates, RenegotiateAt) ->
#connection_states{current_write =
#connection_state{sequence_number = Num}} = ConnectionStates,
diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile
index 9e4aecac45..c0a7f8d257 100644
--- a/lib/ssl/test/Makefile
+++ b/lib/ssl/test/Makefile
@@ -40,6 +40,7 @@ MODULES = \
ssl_packet_SUITE \
ssl_payload_SUITE \
ssl_to_openssl_SUITE \
+ ssl_session_cache_SUITE \
ssl_test_MACHINE \
old_ssl_active_SUITE \
old_ssl_active_once_SUITE \
diff --git a/lib/ssl/test/erl_make_certs.erl b/lib/ssl/test/erl_make_certs.erl
index f8aef55754..8b01ca3ad4 100644
--- a/lib/ssl/test/erl_make_certs.erl
+++ b/lib/ssl/test/erl_make_certs.erl
@@ -268,7 +268,7 @@ publickey(#'RSAPrivateKey'{modulus=N, publicExponent=E}) ->
subjectPublicKey = Public};
publickey(#'DSAPrivateKey'{p=P, q=Q, g=G, y=Y}) ->
Algo = #'PublicKeyAlgorithm'{algorithm= ?'id-dsa',
- parameters=#'Dss-Parms'{p=P, q=Q, g=G}},
+ parameters={params, #'Dss-Parms'{p=P, q=Q, g=G}}},
#'OTPSubjectPublicKeyInfo'{algorithm = Algo, subjectPublicKey = Y}.
validity(Opts) ->
@@ -290,7 +290,7 @@ sign_algorithm(#'RSAPrivateKey'{}, Opts) ->
end,
{Type, 'NULL'};
sign_algorithm(#'DSAPrivateKey'{p=P, q=Q, g=G}, _Opts) ->
- {?'id-dsa-with-sha1', #'Dss-Parms'{p=P, q=Q, g=G}}.
+ {?'id-dsa-with-sha1', {params,#'Dss-Parms'{p=P, q=Q, g=G}}}.
make_key(rsa, _Opts) ->
%% (OBS: for testing only)
diff --git a/lib/ssl/test/ssl_basic_SUITE.erl b/lib/ssl/test/ssl_basic_SUITE.erl
index fade67f3ba..ea84b3c9d1 100644
--- a/lib/ssl/test/ssl_basic_SUITE.erl
+++ b/lib/ssl/test/ssl_basic_SUITE.erl
@@ -34,12 +34,6 @@
-define(EXPIRE, 10).
-define(SLEEP, 500).
--behaviour(ssl_session_cache_api).
-
-%% For the session cache tests
--export([init/1, terminate/1, lookup/2, update/3,
- delete/2, foldl/3, select_session/2]).
-
%% Test server callback functions
%%--------------------------------------------------------------------
%% Function: init_per_suite(Config) -> Config
@@ -89,13 +83,6 @@ end_per_suite(_Config) ->
%% variable, but should NOT alter/remove any existing entries.
%% Description: Initialization before each test case
%%--------------------------------------------------------------------
-init_per_testcase(session_cache_process_list, Config) ->
- init_customized_session_cache(list, Config);
-
-init_per_testcase(session_cache_process_mnesia, Config) ->
- mnesia:start(),
- init_customized_session_cache(mnesia, Config);
-
init_per_testcase(reuse_session_expired, Config0) ->
Config = lists:keydelete(watchdog, 1, Config0),
Dog = ssl_test_lib:timetrap(?EXPIRE * 1000 * 5),
@@ -142,16 +129,6 @@ init_per_testcase(_TestCase, Config0) ->
Dog = test_server:timetrap(?TIMEOUT),
[{watchdog, Dog} | Config].
-init_customized_session_cache(Type, Config0) ->
- Config = lists:keydelete(watchdog, 1, Config0),
- Dog = test_server:timetrap(?TIMEOUT),
- ssl:stop(),
- application:load(ssl),
- application:set_env(ssl, session_cb, ?MODULE),
- application:set_env(ssl, session_cb_init_args, [Type]),
- ssl:start(),
- [{watchdog, Dog} | Config].
-
%%--------------------------------------------------------------------
%% Function: end_per_testcase(TestCase, Config) -> _
%% Case - atom()
@@ -160,16 +137,6 @@ init_customized_session_cache(Type, Config0) ->
%% A list of key/value pairs, holding the test case configuration.
%% Description: Cleanup after each test case
%%--------------------------------------------------------------------
-end_per_testcase(session_cache_process_list, Config) ->
- application:unset_env(ssl, session_cb),
- end_per_testcase(default_action, Config);
-end_per_testcase(session_cache_process_mnesia, Config) ->
- application:unset_env(ssl, session_cb),
- application:unset_env(ssl, session_cb_init_args),
- mnesia:stop(),
- ssl:stop(),
- ssl:start(),
- end_per_testcase(default_action, Config);
end_per_testcase(reuse_session_expired, Config) ->
application:unset_env(ssl, session_lifetime),
end_per_testcase(default_action, Config);
@@ -216,6 +183,8 @@ all(suite) ->
ciphers_dsa_signed_certs_ssl3,
ciphers_dsa_signed_certs_openssl_names,
ciphers_dsa_signed_certs_openssl_names_ssl3,
+ anonymous_cipher_suites,
+ default_reject_anonymous,
send_close,
close_transport_accept, dh_params, server_verify_peer_passive,
server_verify_peer_active, server_verify_peer_active_once,
@@ -226,7 +195,6 @@ all(suite) ->
server_verify_client_once_active,
server_verify_client_once_active_once, client_verify_none_passive,
client_verify_none_active, client_verify_none_active_once,
- session_cache_process_list, session_cache_process_mnesia,
reuse_session, reuse_session_expired,
server_does_not_want_to_reuse_session, client_renegotiate,
server_renegotiate, client_renegotiate_reused_session,
@@ -1165,13 +1133,13 @@ ecertfile(Config) when is_list(Config) ->
Server =
ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
{from, self()},
- {options, ServerBadOpts}]),
+ {options, ServerBadOpts}]),
Port = ssl_test_lib:inet_port(Server),
Client =
ssl_test_lib:start_client_error([{node, ClientNode},
- {port, Port}, {host, Hostname},
+ {port, Port}, {host, Hostname},
{from, self()},
{options, ClientOpts}]),
@@ -1522,6 +1490,14 @@ ciphers_dsa_signed_certs_openssl_names_ssl3(Config) when is_list(Config) ->
Ciphers = ssl_test_lib:openssl_dsa_suites(),
run_suites(Ciphers, Version, Config, dsa).
+anonymous_cipher_suites(doc)->
+ ["Test the anonymous ciphersuites"];
+anonymous_cipher_suites(suite) ->
+ [];
+anonymous_cipher_suites(Config) when is_list(Config) ->
+ Version = ssl_record:protocol_version(ssl_record:highest_protocol_version([])),
+ Ciphers = ssl_test_lib:anonymous_suites(),
+ run_suites(Ciphers, Version, Config, anonymous).
run_suites(Ciphers, Version, Config, Type) ->
{ClientOpts, ServerOpts} =
@@ -1531,8 +1507,12 @@ run_suites(Ciphers, Version, Config, Type) ->
?config(server_opts, Config)};
dsa ->
{?config(client_opts, Config),
- ?config(server_dsa_opts, Config)}
- end,
+ ?config(server_dsa_opts, Config)};
+ anonymous ->
+ %% No certs in opts!
+ {?config(client_opts, Config),
+ ?config(server_anon, Config)}
+ end,
Result = lists:map(fun(Cipher) ->
cipher(Cipher, Version, Config, ClientOpts, ServerOpts) end,
@@ -1593,6 +1573,32 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) ->
end.
%%--------------------------------------------------------------------
+default_reject_anonymous(doc)->
+ ["Test that by default anonymous cipher suites are rejected "];
+default_reject_anonymous(suite) ->
+ [];
+default_reject_anonymous(Config) when is_list(Config) ->
+ {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
+ ClientOpts = ?config(client_opts, Config),
+ ServerOpts = ?config(server_opts, Config),
+
+ [Cipher | _] = ssl_test_lib:anonymous_suites(),
+
+ Server = ssl_test_lib:start_server_error([{node, ServerNode}, {port, 0},
+ {from, self()},
+ {options, ServerOpts}]),
+ Port = ssl_test_lib:inet_port(Server),
+ Client = ssl_test_lib:start_client_error([{node, ClientNode}, {port, Port},
+ {host, Hostname},
+ {from, self()},
+ {options,
+ [{ciphers,[Cipher]} |
+ ClientOpts]}]),
+
+ ssl_test_lib:check_result(Server, {error, "insufficient security"},
+ Client, {error, "insufficient security"}).
+
+%%--------------------------------------------------------------------
reuse_session(doc) ->
["Test reuse of sessions (short handshake)"];
@@ -2952,7 +2958,7 @@ unknown_server_ca_accept_verify_peer(Config) when is_list(Config) ->
%%--------------------------------------------------------------------
unknown_server_ca_accept_backwardscompatibilty(doc) ->
- ["Test that the client succeds if the ca is unknown in verify_none mode"];
+ ["Test that old style verify_funs will work"];
unknown_server_ca_accept_backwardscompatibilty(suite) ->
[];
unknown_server_ca_accept_backwardscompatibilty(Config) when is_list(Config) ->
@@ -3047,6 +3053,17 @@ der_input_opts(Opts) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
+erlang_ssl_receive(Socket, Data) ->
+ receive
+ {ssl, Socket, Data} ->
+ io:format("Received ~p~n",[Data]),
+ ok;
+ Other ->
+ test_server:fail({unexpected_message, Other})
+ after ?SLEEP * 3 ->
+ test_server:fail({did_not_get, Data})
+ end.
+
send_recv_result(Socket) ->
ssl:send(Socket, "Hello world"),
{ok,"Hello world"} = ssl:recv(Socket, 11),
@@ -3086,162 +3103,3 @@ renegotiate_reuse_session(Socket, Data) ->
%% Make sure session is registerd
test_server:sleep(?SLEEP),
renegotiate(Socket, Data).
-
-session_cache_process_list(doc) ->
- ["Test reuse of sessions (short handshake)"];
-
-session_cache_process_list(suite) ->
- [];
-session_cache_process_list(Config) when is_list(Config) ->
- session_cache_process(list,Config).
-
-session_cache_process_mnesia(doc) ->
- ["Test reuse of sessions (short handshake)"];
-
-session_cache_process_mnesia(suite) ->
- [];
-session_cache_process_mnesia(Config) when is_list(Config) ->
- session_cache_process(mnesia,Config).
-
-session_cache_process(_Type,Config) when is_list(Config) ->
- reuse_session(Config).
-
-init([Type]) ->
- ets:new(ssl_test, [named_table, public, set]),
- ets:insert(ssl_test, {type, Type}),
- case Type of
- list ->
- spawn(fun() -> session_loop([]) end);
- mnesia ->
- mnesia:start(),
- {atomic,ok} = mnesia:create_table(sess_cache, []),
- sess_cache
- end.
-
-session_cb() ->
- [{type, Type}] = ets:lookup(ssl_test, type),
- Type.
-
-terminate(Cache) ->
- case session_cb() of
- list ->
- Cache ! terminate;
- mnesia ->
- catch {atomic,ok} =
- mnesia:delete_table(sess_cache)
- end.
-
-lookup(Cache, Key) ->
- case session_cb() of
- list ->
- Cache ! {self(), lookup, Key},
- receive {Cache, Res} -> Res end;
- mnesia ->
- case mnesia:transaction(fun() ->
- mnesia:read(sess_cache,
- Key, read)
- end) of
- {atomic, [{sess_cache, Key, Value}]} ->
- Value;
- _ ->
- undefined
- end
- end.
-
-update(Cache, Key, Value) ->
- case session_cb() of
- list ->
- Cache ! {update, Key, Value};
- mnesia ->
- {atomic, ok} =
- mnesia:transaction(fun() ->
- mnesia:write(sess_cache,
- {sess_cache, Key, Value}, write)
- end)
- end.
-
-delete(Cache, Key) ->
- case session_cb() of
- list ->
- Cache ! {delete, Key};
- mnesia ->
- {atomic, ok} =
- mnesia:transaction(fun() ->
- mnesia:delete(sess_cache, Key)
- end)
- end.
-
-foldl(Fun, Acc, Cache) ->
- case session_cb() of
- list ->
- Cache ! {self(),foldl,Fun,Acc},
- receive {Cache, Res} -> Res end;
- mnesia ->
- Foldl = fun() ->
- mnesia:foldl(Fun, Acc, sess_cache)
- end,
- {atomic, Res} = mnesia:transaction(Foldl),
- Res
- end.
-
-select_session(Cache, PartialKey) ->
- case session_cb() of
- list ->
- Cache ! {self(),select_session, PartialKey},
- receive
- {Cache, Res} ->
- Res
- end;
- mnesia ->
- Sel = fun() ->
- mnesia:select(Cache,
- [{{sess_cache,{PartialKey,'$1'}, '$2'},
- [],['$$']}])
- end,
- {atomic, Res} = mnesia:transaction(Sel),
- Res
- end.
-
-session_loop(Sess) ->
- receive
- terminate ->
- ok;
- {Pid, lookup, Key} ->
- case lists:keysearch(Key,1,Sess) of
- {value, {Key,Value}} ->
- Pid ! {self(), Value};
- _ ->
- Pid ! {self(), undefined}
- end,
- session_loop(Sess);
- {update, Key, Value} ->
- NewSess = [{Key,Value}| lists:keydelete(Key,1,Sess)],
- session_loop(NewSess);
- {delete, Key} ->
- session_loop(lists:keydelete(Key,1,Sess));
- {Pid,foldl,Fun,Acc} ->
- Res = lists:foldl(Fun, Acc,Sess),
- Pid ! {self(), Res},
- session_loop(Sess);
- {Pid,select_session,PKey} ->
- Sel = fun({{PKey0, Id},Session}, Acc) when PKey == PKey0 ->
- [[Id, Session]|Acc];
- (_,Acc) ->
- Acc
- end,
- Sessions = lists:foldl(Sel, [], Sess),
- Pid ! {self(), Sessions},
- session_loop(Sess)
- end.
-
-
-erlang_ssl_receive(Socket, Data) ->
- receive
- {ssl, Socket, Data} ->
- io:format("Received ~p~n",[Data]),
- ok;
- Other ->
- test_server:fail({unexpected_message, Other})
- after ?SLEEP * 3 ->
- test_server:fail({did_not_get, Data})
- end.
diff --git a/lib/ssl/test/ssl_session_cache_SUITE.erl b/lib/ssl/test/ssl_session_cache_SUITE.erl
new file mode 100644
index 0000000000..7a441e4599
--- /dev/null
+++ b/lib/ssl/test/ssl_session_cache_SUITE.erl
@@ -0,0 +1,305 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2010. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.2
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+%%
+
+-module(ssl_session_cache_SUITE).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-include("test_server.hrl").
+
+-define(SLEEP, 500).
+-define(TIMEOUT, 60000).
+-behaviour(ssl_session_cache_api).
+
+%% For the session cache tests
+-export([init/1, terminate/1, lookup/2, update/3,
+ delete/2, foldl/3, select_session/2]).
+
+%% Test server callback functions
+%%--------------------------------------------------------------------
+%% Function: init_per_suite(Config) -> Config
+%% Config - [tuple()]
+%% A list of key/value pairs, holding the test case configuration.
+%% Description: Initialization before the whole suite
+%%
+%% Note: This function is free to add any key/value pairs to the Config
+%% variable, but should NOT alter/remove any existing entries.
+%%--------------------------------------------------------------------
+init_per_suite(Config0) ->
+ Dog = ssl_test_lib:timetrap(?TIMEOUT *2),
+ crypto:start(),
+ application:start(public_key),
+ ssl:start(),
+
+ %% make rsa certs using oppenssl
+ Result =
+ (catch make_certs:all(?config(data_dir, Config0),
+ ?config(priv_dir, Config0))),
+ test_server:format("Make certs ~p~n", [Result]),
+
+ Config1 = ssl_test_lib:make_dsa_cert(Config0),
+ Config = ssl_test_lib:cert_options(Config1),
+ [{watchdog, Dog} | Config].
+
+%%--------------------------------------------------------------------
+%% Function: end_per_suite(Config) -> _
+%% Config - [tuple()]
+%% A list of key/value pairs, holding the test case configuration.
+%% Description: Cleanup after the whole suite
+%%--------------------------------------------------------------------
+end_per_suite(_Config) ->
+ ssl:stop(),
+ crypto:stop().
+
+%%--------------------------------------------------------------------
+%% Function: init_per_testcase(TestCase, Config) -> Config
+%% Case - atom()
+%% Name of the test case that is about to be run.
+%% Config - [tuple()]
+%% A list of key/value pairs, holding the test case configuration.
+%%
+%% Description: Initialization before each test case
+%%
+%% Note: This function is free to add any key/value pairs to the Config
+%% variable, but should NOT alter/remove any existing entries.
+%% Description: Initialization before each test case
+%%--------------------------------------------------------------------
+init_per_testcase(session_cache_process_list, Config) ->
+ init_customized_session_cache(list, Config);
+
+init_per_testcase(session_cache_process_mnesia, Config) ->
+ mnesia:start(),
+ init_customized_session_cache(mnesia, Config);
+
+init_per_testcase(_TestCase, Config0) ->
+ Config = lists:keydelete(watchdog, 1, Config0),
+ Dog = test_server:timetrap(?TIMEOUT),
+ [{watchdog, Dog} | Config].
+
+init_customized_session_cache(Type, Config0) ->
+ Config = lists:keydelete(watchdog, 1, Config0),
+ Dog = test_server:timetrap(?TIMEOUT),
+ ssl:stop(),
+ application:load(ssl),
+ application:set_env(ssl, session_cb, ?MODULE),
+ application:set_env(ssl, session_cb_init_args, [Type]),
+ ssl:start(),
+ [{watchdog, Dog} | Config].
+
+%%--------------------------------------------------------------------
+%% Function: end_per_testcase(TestCase, Config) -> _
+%% Case - atom()
+%% Name of the test case that is about to be run.
+%% Config - [tuple()]
+%% A list of key/value pairs, holding the test case configuration.
+%% Description: Cleanup after each test case
+%%--------------------------------------------------------------------
+end_per_testcase(session_cache_process_list, Config) ->
+ application:unset_env(ssl, session_cb),
+ end_per_testcase(default_action, Config);
+end_per_testcase(session_cache_process_mnesia, Config) ->
+ application:unset_env(ssl, session_cb),
+ application:unset_env(ssl, session_cb_init_args),
+ mnesia:stop(),
+ ssl:stop(),
+ ssl:start(),
+ end_per_testcase(default_action, Config);
+end_per_testcase(_TestCase, Config) ->
+ Dog = ?config(watchdog, Config),
+ case Dog of
+ undefined ->
+ ok;
+ _ ->
+ test_server:timetrap_cancel(Dog)
+ end.
+
+%%--------------------------------------------------------------------
+%% Function: all(Clause) -> TestCases
+%% Clause - atom() - suite | doc
+%% TestCases - [Case]
+%% Case - atom()
+%% Name of a test case.
+%% Description: Returns a list of all test cases in this test suite
+%%--------------------------------------------------------------------
+all(doc) ->
+ ["Test session cach API"];
+
+all(suite) ->
+ [
+ session_cache_process_list, session_cache_process_mnesia
+ ].
+
+session_cache_process_list(doc) ->
+ ["Test reuse of sessions (short handshake)"];
+
+session_cache_process_list(suite) ->
+ [];
+session_cache_process_list(Config) when is_list(Config) ->
+ session_cache_process(list,Config).
+%%--------------------------------------------------------------------
+session_cache_process_mnesia(doc) ->
+ ["Test reuse of sessions (short handshake)"];
+
+session_cache_process_mnesia(suite) ->
+ [];
+session_cache_process_mnesia(Config) when is_list(Config) ->
+ session_cache_process(mnesia,Config).
+
+
+%%--------------------------------------------------------------------
+%%% Session cache API callbacks
+%%--------------------------------------------------------------------
+
+init([Type]) ->
+ ets:new(ssl_test, [named_table, public, set]),
+ ets:insert(ssl_test, {type, Type}),
+ case Type of
+ list ->
+ spawn(fun() -> session_loop([]) end);
+ mnesia ->
+ mnesia:start(),
+ {atomic,ok} = mnesia:create_table(sess_cache, []),
+ sess_cache
+ end.
+
+session_cb() ->
+ [{type, Type}] = ets:lookup(ssl_test, type),
+ Type.
+
+terminate(Cache) ->
+ case session_cb() of
+ list ->
+ Cache ! terminate;
+ mnesia ->
+ catch {atomic,ok} =
+ mnesia:delete_table(sess_cache)
+ end.
+
+lookup(Cache, Key) ->
+ case session_cb() of
+ list ->
+ Cache ! {self(), lookup, Key},
+ receive {Cache, Res} -> Res end;
+ mnesia ->
+ case mnesia:transaction(fun() ->
+ mnesia:read(sess_cache,
+ Key, read)
+ end) of
+ {atomic, [{sess_cache, Key, Value}]} ->
+ Value;
+ _ ->
+ undefined
+ end
+ end.
+
+update(Cache, Key, Value) ->
+ case session_cb() of
+ list ->
+ Cache ! {update, Key, Value};
+ mnesia ->
+ {atomic, ok} =
+ mnesia:transaction(fun() ->
+ mnesia:write(sess_cache,
+ {sess_cache, Key, Value}, write)
+ end)
+ end.
+
+delete(Cache, Key) ->
+ case session_cb() of
+ list ->
+ Cache ! {delete, Key};
+ mnesia ->
+ {atomic, ok} =
+ mnesia:transaction(fun() ->
+ mnesia:delete(sess_cache, Key)
+ end)
+ end.
+
+foldl(Fun, Acc, Cache) ->
+ case session_cb() of
+ list ->
+ Cache ! {self(),foldl,Fun,Acc},
+ receive {Cache, Res} -> Res end;
+ mnesia ->
+ Foldl = fun() ->
+ mnesia:foldl(Fun, Acc, sess_cache)
+ end,
+ {atomic, Res} = mnesia:transaction(Foldl),
+ Res
+ end.
+
+select_session(Cache, PartialKey) ->
+ case session_cb() of
+ list ->
+ Cache ! {self(),select_session, PartialKey},
+ receive
+ {Cache, Res} ->
+ Res
+ end;
+ mnesia ->
+ Sel = fun() ->
+ mnesia:select(Cache,
+ [{{sess_cache,{PartialKey,'$1'}, '$2'},
+ [],['$$']}])
+ end,
+ {atomic, Res} = mnesia:transaction(Sel),
+ Res
+ end.
+
+session_loop(Sess) ->
+ receive
+ terminate ->
+ ok;
+ {Pid, lookup, Key} ->
+ case lists:keysearch(Key,1,Sess) of
+ {value, {Key,Value}} ->
+ Pid ! {self(), Value};
+ _ ->
+ Pid ! {self(), undefined}
+ end,
+ session_loop(Sess);
+ {update, Key, Value} ->
+ NewSess = [{Key,Value}| lists:keydelete(Key,1,Sess)],
+ session_loop(NewSess);
+ {delete, Key} ->
+ session_loop(lists:keydelete(Key,1,Sess));
+ {Pid,foldl,Fun,Acc} ->
+ Res = lists:foldl(Fun, Acc,Sess),
+ Pid ! {self(), Res},
+ session_loop(Sess);
+ {Pid,select_session,PKey} ->
+ Sel = fun({{PKey0, Id},Session}, Acc) when PKey == PKey0 ->
+ [[Id, Session]|Acc];
+ (_,Acc) ->
+ Acc
+ end,
+ Sessions = lists:foldl(Sel, [], Sess),
+ Pid ! {self(), Sessions},
+ session_loop(Sess)
+ end.
+
+%%--------------------------------------------------------------------
+%%% Internal functions
+%%--------------------------------------------------------------------
+
+session_cache_process(_Type,Config) when is_list(Config) ->
+ ssl_basic_SUITE:reuse_session(Config).
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index ce164f7e4c..e1e8214ed6 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -300,6 +300,7 @@ cert_options(Config) ->
{ssl_imp, new}]},
{server_opts, [{ssl_imp, new},{reuseaddr, true},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile}]},
+ {server_anon, [{ssl_imp, new},{reuseaddr, true}, {ciphers, anonymous_suites()}]},
{server_verification_opts, [{ssl_imp, new},{reuseaddr, true},
{cacertfile, ServerCaCertFile},
{certfile, ServerCertFile}, {keyfile, ServerKeyFile}]},
@@ -616,6 +617,13 @@ openssl_dsa_suites() ->
end
end, Ciphers).
+anonymous_suites() ->
+ [{dh_anon, rc4_128, md5},
+ {dh_anon, des_cbc, sha},
+ {dh_anon, '3des_ede_cbc', sha},
+ {dh_anon, aes_128_cbc, sha},
+ {dh_anon, aes_256_cbc, sha}].
+
pem_to_der(File) ->
{ok, PemBin} = file:read_file(File),
public_key:pem_decode(PemBin).
@@ -633,7 +641,7 @@ cipher_result(Socket, Result) ->
receive
{ssl, Socket, "Hello\n"} ->
ssl:send(Socket, " world\n"),
- receive
+ receive
{ssl, Socket, " world\n"} ->
ok
end;
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index 7f512f2ab9..55a0100b1e 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -1116,8 +1116,6 @@ run_suites(Ciphers, Version, Config, Type) ->
test_server:fail(cipher_suite_failed_see_test_case_log)
end.
-
-
cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) ->
process_flag(trap_exit, true),
test_server:format("Testing CipherSuite ~p~n", [CipherSuite]),
@@ -1128,8 +1126,8 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) ->
KeyFile = proplists:get_value(keyfile, ServerOpts),
Cmd = "openssl s_server -accept " ++ integer_to_list(Port) ++
- " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "",
-
+ " -cert " ++ CertFile ++ " -key " ++ KeyFile ++ "",
+
test_server:format("openssl cmd: ~p~n", [Cmd]),
OpenSslPort = open_port({spawn, Cmd}, [stderr_to_stdout]),
@@ -1140,11 +1138,11 @@ cipher(CipherSuite, Version, Config, ClientOpts, ServerOpts) ->
Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port},
{host, Hostname},
- {from, self()},
- {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}},
- {options,
- [{ciphers,[CipherSuite]} |
- ClientOpts]}]),
+ {from, self()},
+ {mfa, {ssl_test_lib, cipher_result, [ConnectionInfo]}},
+ {options,
+ [{ciphers,[CipherSuite]} |
+ ClientOpts]}]),
port_command(OpenSslPort, "Hello\n"),
diff --git a/lib/stdlib/doc/src/filelib.xml b/lib/stdlib/doc/src/filelib.xml
index c1c4ca9350..4ff3b22f32 100644
--- a/lib/stdlib/doc/src/filelib.xml
+++ b/lib/stdlib/doc/src/filelib.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2003</year><year>2009</year>
+ <year>2003</year><year>2010</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -160,6 +160,12 @@ DeepList = [char() | atom() | DeepList]</code>
<p>Matches any number of characters up to the end of
the filename, the next dot, or the next slash.</p>
</item>
+ <tag>[Character1,Character2,...]</tag>
+ <item>
+ <p>Matches any of the characters listed. Two characters
+ separated by a hyphen will match a range of characters.
+ Example: <c>[A-Z]</c> will match any uppercase letter.</p>
+ </item>
<tag>{Item,...}</tag>
<item>
<p>Alternation. Matches one of the alternatives.</p>
diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml
index c696434d49..45fa0847a8 100644
--- a/lib/stdlib/doc/src/supervisor.xml
+++ b/lib/stdlib/doc/src/supervisor.xml
@@ -156,7 +156,7 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules}
the child process to terminate by calling
<c>exit(Child,shutdown)</c> and then wait for an exit signal
with reason <c>shutdown</c> back from the child process. If
- no exit signal is received within the specified time,
+ no exit signal is received within the specified number of milliseconds,
the child process is unconditionally terminated using
<c>exit(Child,kill)</c>.</p>
<p>If the child process is another supervisor, <c>Shutdown</c>
diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl
index 4584b8184f..6c91f1efb7 100644
--- a/lib/stdlib/src/dets.erl
+++ b/lib/stdlib/src/dets.erl
@@ -147,6 +147,7 @@
bin, % small chunk not consumed, or 'eof' at end-of-file
alloc, % the part of the file not yet scanned, mostly a binary
tab,
+ proc, % the pid of the Dets process
match_program % true | compiled_match_spec() | undefined
}).
@@ -208,8 +209,6 @@ all() ->
bchunk(Tab, start) ->
badarg(treq(Tab, {bchunk_init, Tab}), [Tab, start]);
-bchunk(Tab, #dets_cont{bin = eof, tab = Tab}) ->
- '$end_of_table';
bchunk(Tab, #dets_cont{what = bchunk, tab = Tab} = State) ->
badarg(treq(Tab, {bchunk, State}), [Tab, State]);
bchunk(Tab, Term) ->
@@ -722,11 +721,14 @@ init_chunk_match(Tab, Pat, What, N) when is_integer(N), N >= 0;
N =:= default ->
case compile_match_spec(What, Pat) of
{Spec, MP} ->
- case req(dets_server:get_pid(Tab), {match, MP, Spec, N}) of
+ Proc = dets_server:get_pid(Tab),
+ case req(Proc, {match, MP, Spec, N}) of
{done, L} ->
- {L, #dets_cont{tab = Tab, what = What, bin = eof}};
+ {L, #dets_cont{tab = Tab, proc = Proc, what = What,
+ bin = eof}};
{cont, State} ->
- chunk_match(State#dets_cont{what = What, tab = Tab});
+ chunk_match(State#dets_cont{what = What, tab = Tab,
+ proc = Proc});
Error ->
Error
end;
@@ -736,34 +738,28 @@ init_chunk_match(Tab, Pat, What, N) when is_integer(N), N >= 0;
init_chunk_match(_Tab, _Pat, _What, _) ->
badarg.
-chunk_match(State) ->
- case catch dets_server:get_pid(State#dets_cont.tab) of
- {'EXIT', _Reason} ->
- badarg;
- _Proc when State#dets_cont.bin =:= eof ->
- '$end_of_table';
- Proc ->
- case req(Proc, {match_init, State}) of
- {cont, {Bins, NewState}} ->
- MP = NewState#dets_cont.match_program,
- case catch do_foldl_bins(Bins, MP) of
- {'EXIT', _} ->
- case ets:is_compiled_ms(MP) of
- true ->
- Bad = dets_utils:bad_object(chunk_match,
- Bins),
- req(Proc, {corrupt, Bad});
- false ->
- badarg
- end;
- [] ->
- chunk_match(NewState);
- Terms ->
- {Terms, NewState}
- end;
- Error ->
- Error
- end
+chunk_match(#dets_cont{proc = Proc}=State) ->
+ case req(Proc, {match_init, State}) of
+ '$end_of_table'=Reply ->
+ Reply;
+ {cont, {Bins, NewState}} ->
+ MP = NewState#dets_cont.match_program,
+ case catch do_foldl_bins(Bins, MP) of
+ {'EXIT', _} ->
+ case ets:is_compiled_ms(MP) of
+ true ->
+ Bad = dets_utils:bad_object(chunk_match, Bins),
+ req(Proc, {corrupt, Bad});
+ false ->
+ badarg
+ end;
+ [] ->
+ chunk_match(NewState);
+ Terms ->
+ {Terms, NewState}
+ end;
+ Error ->
+ Error
end.
do_foldl_bins(Bins, true) ->
@@ -1094,7 +1090,9 @@ do_apply_op(Op, From, Head, N) ->
{N2, H2} when is_record(H2, head), is_integer(N2) ->
open_file_loop(H2, N2);
H2 when is_record(H2, head) ->
- open_file_loop(H2, N)
+ open_file_loop(H2, N);
+ {{more,From1,Op1,N1}, NewHead} ->
+ do_apply_op(Op1, From1, NewHead, N1)
catch
exit:normal ->
exit(normal);
@@ -1363,37 +1361,35 @@ start_auto_save_timer(Head) ->
%% lookup requests in parallel. Evalute delete_object, delete and
%% insert as well.
stream_op(Op, Pid, Pids, Head, N) ->
- stream_op(Head, Pids, [], N, Pid, Op, Head#head.fixed).
+ #head{fixed = Fxd, update_mode = M} = Head,
+ stream_op(Head, Pids, [], N, Pid, Op, Fxd, M).
-stream_loop(Head, Pids, C, N, false = Fxd) ->
+stream_loop(Head, Pids, C, N, false = Fxd, M) ->
receive
?DETS_CALL(From, Message) ->
- stream_op(Head, Pids, C, N, From, Message, Fxd)
+ stream_op(Head, Pids, C, N, From, Message, Fxd, M)
after 0 ->
stream_end(Head, Pids, C, N, no_more)
end;
-stream_loop(Head, Pids, C, N, _Fxd) ->
+stream_loop(Head, Pids, C, N, _Fxd, _M) ->
stream_end(Head, Pids, C, N, no_more).
-stream_op(Head, Pids, C, N, Pid, {lookup_keys,Keys}, Fxd) ->
+stream_op(Head, Pids, C, N, Pid, {lookup_keys,Keys}, Fxd, M) ->
NC = [{{lookup,Pid},Keys} | C],
- stream_loop(Head, Pids, NC, N, Fxd);
-stream_op(Head, Pids, C, N, Pid, {insert, _Objects} = Op, Fxd) ->
- NC = [Op | C],
- stream_loop(Head, [Pid | Pids], NC, N, Fxd);
-stream_op(Head, Pids, C, N, Pid, {insert_new, _Objects} = Op, Fxd) ->
+ stream_loop(Head, Pids, NC, N, Fxd, M);
+stream_op(Head, Pids, C, N, Pid, {insert, _Objects} = Op, Fxd, dirty = M) ->
NC = [Op | C],
- stream_loop(Head, [Pid | Pids], NC, N, Fxd);
-stream_op(Head, Pids, C, N, Pid, {delete_key, _Keys} = Op, Fxd) ->
+ stream_loop(Head, [Pid | Pids], NC, N, Fxd, M);
+stream_op(Head, Pids, C, N, Pid, {delete_key, _Keys} = Op, Fxd, dirty = M) ->
NC = [Op | C],
- stream_loop(Head, [Pid | Pids], NC, N, Fxd);
-stream_op(Head, Pids, C, N, Pid, {delete_object, _Objects} = Op, Fxd) ->
+ stream_loop(Head, [Pid | Pids], NC, N, Fxd, M);
+stream_op(Head, Pids, C, N, Pid, {delete_object, _Os} = Op, Fxd, dirty = M) ->
NC = [Op | C],
- stream_loop(Head, [Pid | Pids], NC, N, Fxd);
-stream_op(Head, Pids, C, N, Pid, {member, Key}, Fxd) ->
+ stream_loop(Head, [Pid | Pids], NC, N, Fxd, M);
+stream_op(Head, Pids, C, N, Pid, {member, Key}, Fxd, M) ->
NC = [{{lookup,[Pid]},[Key]} | C],
- stream_loop(Head, Pids, NC, N, Fxd);
-stream_op(Head, Pids, C, N, Pid, Op, _Fxd) ->
+ stream_loop(Head, Pids, NC, N, Fxd, M);
+stream_op(Head, Pids, C, N, Pid, Op, _Fxd, _M) ->
stream_end(Head, Pids, C, N, {Pid,Op}).
stream_end(Head, Pids0, C, N, Next) ->
@@ -1438,7 +1434,7 @@ stream_end2([], Ps, no_more, N, C, Head, _Reply) ->
penalty(Head, Ps, C),
{N, Head};
stream_end2([], _Ps, {From, Op}, N, _C, Head, _Reply) ->
- apply_op(Op, From, Head, N).
+ {{more,From,Op,N},Head}.
penalty(H, _Ps, _C) when H#head.fixed =:= false ->
ok;
@@ -1578,13 +1574,18 @@ do_bchunk_init(Head, Tab) ->
L = dets_utils:all_allocated(H2),
C0 = #dets_cont{no_objs = default, bin = <<>>, alloc = L},
BinParms = term_to_binary(Parms),
- {H2, {C0#dets_cont{tab = Tab, what = bchunk}, [BinParms]}}
+ {H2, {C0#dets_cont{tab = Tab, proc = self(),what = bchunk},
+ [BinParms]}}
end;
{NewHead, _} = HeadError when is_record(NewHead, head) ->
HeadError
end.
%% -> {NewHead, {cont(), [binary()]}} | {NewHead, Error}
+do_bchunk(Head, #dets_cont{proc = Proc}) when Proc =/= self() ->
+ {Head, badarg};
+do_bchunk(Head, #dets_cont{bin = eof}) ->
+ {Head, '$end_of_table'};
do_bchunk(Head, State) ->
case dets_v9:read_bchunks(Head, State#dets_cont.alloc) of
{error, Reason} ->
@@ -1954,6 +1955,8 @@ flookup_keys(Head, Keys) ->
end.
%% -> {NewHead, Result}
+fmatch_init(Head, #dets_cont{bin = eof}) ->
+ {Head, '$end_of_table'};
fmatch_init(Head, C) ->
case scan(Head, C) of
{scan_error, Reason} ->
diff --git a/lib/stdlib/src/digraph.erl b/lib/stdlib/src/digraph.erl
index b5f52da921..5edc868a94 100644
--- a/lib/stdlib/src/digraph.erl
+++ b/lib/stdlib/src/digraph.erl
@@ -36,7 +36,7 @@
-export([get_short_path/3, get_short_cycle/2]).
--export_type([d_type/0, vertex/0]).
+-export_type([digraph/0, d_type/0, vertex/0]).
-record(digraph, {vtab = notable :: ets:tab(),
etab = notable :: ets:tab(),
diff --git a/lib/stdlib/src/gb_sets.erl b/lib/stdlib/src/gb_sets.erl
index 086dc79b46..113f29e252 100644
--- a/lib/stdlib/src/gb_sets.erl
+++ b/lib/stdlib/src/gb_sets.erl
@@ -657,7 +657,7 @@ intersection_2([], _, As, S) ->
intersection_2(_, [], As, S) ->
{S, balance_revlist(As, S)}.
--spec intersection([gb_set()]) -> gb_set().
+-spec intersection([gb_set(),...]) -> gb_set().
intersection([S | Ss]) ->
intersection_list(S, Ss).
diff --git a/lib/stdlib/src/lists.erl b/lib/stdlib/src/lists.erl
index 08ee595f4d..431e5b114e 100644
--- a/lib/stdlib/src/lists.erl
+++ b/lib/stdlib/src/lists.erl
@@ -350,7 +350,7 @@ sort_1(X, [], R) ->
%% merge(List) -> L
%% merges a list of sorted lists
--spec merge([T]) -> [T].
+-spec merge([[T]]) -> [T].
merge(L) ->
mergel(L, []).
@@ -842,7 +842,7 @@ usort_1(X, []) ->
%% umerge(List) -> L
%% merges a list of sorted lists without duplicates, removes duplicates
--spec umerge([T]) -> [T].
+-spec umerge([[T]]) -> [T].
umerge(L) ->
umergel(L).
diff --git a/lib/stdlib/src/orddict.erl b/lib/stdlib/src/orddict.erl
index c7b52b933e..8a13992785 100644
--- a/lib/stdlib/src/orddict.erl
+++ b/lib/stdlib/src/orddict.erl
@@ -151,7 +151,7 @@ map(F, [{Key,Val}|D]) ->
[{Key,F(Key, Val)}|map(F, D)];
map(F, []) when is_function(F, 2) -> [].
--spec filter(fun((term(), term()) -> term()), orddict()) -> orddict().
+-spec filter(fun((term(), term()) -> boolean()), orddict()) -> orddict().
filter(F, [{Key,Val}=E|D]) ->
case F(Key, Val) of
diff --git a/lib/stdlib/src/ordsets.erl b/lib/stdlib/src/ordsets.erl
index 05041c15f1..e992b66714 100644
--- a/lib/stdlib/src/ordsets.erl
+++ b/lib/stdlib/src/ordsets.erl
@@ -147,7 +147,7 @@ intersection(_, []) ->
%% intersection([OrdSet]) -> OrdSet.
%% Return the intersection of the list of ordered sets.
--spec intersection([ordset(_)]) -> ordset(_).
+-spec intersection([ordset(_),...]) -> ordset(_).
intersection([S1,S2|Ss]) ->
intersection1(intersection(S1, S2), Ss);
diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl
index f5d5441184..5bdd1a8672 100644
--- a/lib/stdlib/src/supervisor.erl
+++ b/lib/stdlib/src/supervisor.erl
@@ -33,7 +33,9 @@
-export([init/1, handle_call/3, handle_info/2, terminate/2, code_change/3]).
-export([handle_cast/2]).
--export_type([child_spec/0, strategy/0]).
+%%--------------------------------------------------------------------------
+
+-export_type([child_spec/0, del_err/0, startchild_ret/0, strategy/0]).
%%--------------------------------------------------------------------------
@@ -77,6 +79,10 @@
-define(is_simple(State), State#state.strategy =:= simple_one_for_one).
+%%--------------------------------------------------------------------------
+
+-spec behaviour_info(atom()) -> 'undefined' | [{atom(), arity()}].
+
behaviour_info(callbacks) ->
[{init,1}];
behaviour_info(_Other) ->
@@ -160,11 +166,13 @@ check_childspecs(X) -> {error, {badarg, X}}.
%%%
%%% ---------------------------------------------------
+-type init_sup_name() :: sup_name() | 'self'.
+
-type stop_rsn() :: 'shutdown' | {'bad_return', {module(),'init', term()}}
| {'bad_start_spec', term()} | {'start_spec', term()}
| {'supervisor_data', term()}.
--spec init({sup_name(), module(), [term()]}) ->
+-spec init({init_sup_name(), module(), [term()]}) ->
{'ok', state()} | 'ignore' | {'stop', stop_rsn()}.
init({SupName, Mod, Args}) ->
@@ -184,7 +192,7 @@ init({SupName, Mod, Args}) ->
Error ->
{stop, {bad_return, {Mod, init, Error}}}
end.
-
+
init_children(State, StartSpec) ->
SupName = State#state.name,
case check_startspec(StartSpec) of
diff --git a/lib/stdlib/src/timer.erl b/lib/stdlib/src/timer.erl
index 24e14caa69..b456c5d6c1 100644
--- a/lib/stdlib/src/timer.erl
+++ b/lib/stdlib/src/timer.erl
@@ -33,6 +33,9 @@
%% internal exports for test purposes only
-export([get_status/0]).
+%% types which can be used by other modules
+-export_type([tref/0]).
+
%% Max
-define(MAX_TIMEOUT, 16#0800000).
-define(TIMER_TAB, timer_tab).
diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl
index 760e610e00..a1f70dc27d 100644
--- a/lib/stdlib/test/dets_SUITE.erl
+++ b/lib/stdlib/test/dets_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -50,7 +50,7 @@
otp_4208/1, otp_4989/1, many_clients/1, otp_4906/1, otp_5402/1,
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_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1]).
-export([dets_dirty_loop/0]).
@@ -108,7 +108,7 @@ all(suite) ->
cache_duplicate_bags_v9, otp_4208, otp_4989, many_clients,
otp_4906, otp_5402, simultaneous_open, insert_new,
repair_continuation, otp_5487, otp_6206, otp_6359, otp_4738,
- otp_7146, otp_8070]}
+ otp_7146, otp_8070, otp_8856, otp_8898, otp_8899, otp_8903]}
end.
not_run(suite) -> [];
@@ -2935,6 +2935,57 @@ ets_init(Tab, N) ->
ets:insert(Tab, {N,N}),
ets_init(Tab, N - 1).
+otp_8898(doc) ->
+ ["OTP-8898. Truncated Dets file."];
+otp_8898(suite) ->
+ [];
+otp_8898(Config) when is_list(Config) ->
+ Tab = otp_8898,
+ ?line FName = filename(Tab, Config),
+
+ Server = self(),
+
+ ?line file:delete(FName),
+ ?line {ok, _} = dets:open_file(Tab,[{file, FName}]),
+ ?line [P1,P2,P3] = new_clients(3, Tab),
+
+ Seq = [{P1,[sync]},{P2,[{lookup,1,[]}]},{P3,[{insert,{1,b}}]}],
+ ?line atomic_requests(Server, Tab, [[]], Seq),
+ ?line true = get_replies([{P1,ok},{P2,ok},{P3,ok}]),
+ ?line ok = dets:close(Tab),
+ ?line {ok, _} = dets:open_file(Tab,[{file, FName}]),
+ ?line file:delete(FName),
+
+ ok.
+
+otp_8899(doc) ->
+ ["OTP-8899. Several clients. Updated Head was ignored."];
+otp_8899(suite) ->
+ [];
+otp_8899(Config) when is_list(Config) ->
+ Tab = many_clients,
+ ?line FName = filename(Tab, Config),
+
+ Server = self(),
+
+ ?line file:delete(FName),
+ ?line {ok, _} = dets:open_file(Tab,[{file, FName},{version,9}]),
+ ?line [P1,P2,P3,P4] = new_clients(4, Tab),
+
+ MC = [Tab],
+ Seq6a = [{P1,[{insert,[{used_to_be_skipped_by,match}]},
+ {lookup,1,[{1,a}]}]},
+ {P2,[{verbose,true,MC}]},
+ {P3,[{lookup,1,[{1,a}]}]}, {P4,[{verbose,true,MC}]}],
+ ?line atomic_requests(Server, Tab, [[{1,a},{2,b},{3,c}]], Seq6a),
+ ?line true = get_replies([{P1,ok}, {P2,ok}, {P3,ok}, {P4,ok}]),
+ ?line [{1,a},{2,b},{3,c},{used_to_be_skipped_by,match}] =
+ lists:sort(dets:match_object(Tab, '_')),
+ ?line _ = dets:close(Tab),
+ ?line file:delete(FName),
+
+ ok.
+
many_clients(doc) ->
["Several clients accessing a table simultaneously."];
many_clients(suite) ->
@@ -3071,6 +3122,11 @@ client(S, Tab) ->
eval([], _Tab) ->
ok;
+eval([{verbose,Bool,Expected} | L], Tab) ->
+ ?line case dets:verbose(Bool) of
+ Expected -> eval(L, Tab);
+ Error -> {error, {verbose,Error}}
+ end;
eval([sync | L], Tab) ->
?line case dets:sync(Tab) of
ok -> eval(L, Tab);
@@ -3701,6 +3757,54 @@ otp_8070(Config) when is_list(Config) ->
file:delete(File),
ok.
+otp_8856(doc) ->
+ ["OTP-8856. insert_new() bug."];
+otp_8856(suite) ->
+ [];
+otp_8856(Config) when is_list(Config) ->
+ Tab = otp_8856,
+ File = filename(Tab, Config),
+ file:delete(File),
+ Me = self(),
+ ?line {ok, _} = dets:open_file(Tab, [{type, bag}, {file, File}]),
+ spawn(fun()-> Me ! {1, dets:insert(Tab, [])} end),
+ spawn(fun()-> Me ! {2, dets:insert_new(Tab, [])} end),
+ ?line ok = dets:close(Tab),
+ ?line receive {1, ok} -> ok end,
+ ?line receive {2, true} -> ok end,
+ file:delete(File),
+
+ ?line {ok, _} = dets:open_file(Tab, [{type, set}, {file, File}]),
+ spawn(fun() -> dets:delete(Tab, 0) end),
+ spawn(fun() -> Me ! {3, dets:insert_new(Tab, {0,0})} end),
+ ?line ok = dets:close(Tab),
+ ?line receive {3, true} -> ok end,
+ file:delete(File),
+ ok.
+
+otp_8903(doc) ->
+ ["OTP-8903. bchunk/match/select bug."];
+otp_8903(suite) ->
+ [];
+otp_8903(Config) when is_list(Config) ->
+ Tab = otp_8903,
+ File = filename(Tab, Config),
+ ?line {ok,T} = dets:open_file(bug, [{file,File}]),
+ ?line ok = dets:insert(T, [{1,a},{2,b},{3,c}]),
+ ?line dets:safe_fixtable(T, true),
+ ?line {[_],C1} = dets:match_object(T, '_', 1),
+ ?line {BC1,_D} = dets:bchunk(T, start),
+ ?line ok = dets:close(T),
+ ?line {'EXIT', {badarg, _}} = (catch {foo,dets:match_object(C1)}),
+ ?line {'EXIT', {badarg, _}} = (catch {foo,dets:bchunk(T, BC1)}),
+ ?line {ok,T} = dets:open_file(bug, [{file,File}]),
+ ?line false = dets:info(T, safe_fixed),
+ ?line {'EXIT', {badarg, _}} = (catch {foo,dets:match_object(C1)}),
+ ?line {'EXIT', {badarg, _}} = (catch {foo,dets:bchunk(T, BC1)}),
+ ?line ok = dets:close(T),
+ file:delete(File),
+ ok.
+
%%
%% Parts common to several test cases
%%
diff --git a/lib/stdlib/test/escript_SUITE.erl b/lib/stdlib/test/escript_SUITE.erl
index 77fd190e45..162ca6006f 100644
--- a/lib/stdlib/test/escript_SUITE.erl
+++ b/lib/stdlib/test/escript_SUITE.erl
@@ -31,6 +31,7 @@
epp/1,
create_and_extract/1,
foldl/1,
+ overflow/1,
verify_sections/3
]).
@@ -48,7 +49,8 @@ all(suite) ->
archive_script,
epp,
create_and_extract,
- foldl
+ foldl,
+ overflow
].
init_per_testcase(_Case, Config) ->
@@ -736,6 +738,17 @@ emulate_escript_foldl(Fun, Acc, File) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+overflow(Config) when is_list(Config) ->
+ Data = ?config(data_dir, Config),
+ Dir = filename:absname(Data), %Get rid of trailing slash.
+ ?line run(Dir, "arg_overflow",
+ [<<"ExitCode:0">>]),
+ ?line run(Dir, "linebuf_overflow",
+ [<<"ExitCode:0">>]),
+ ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
run(Dir, Cmd0, Expected0) ->
Expected = iolist_to_binary(expected_output(Expected0, Dir)),
Cmd = case os:type() of
diff --git a/lib/stdlib/test/escript_SUITE_data/arg_overflow b/lib/stdlib/test/escript_SUITE_data/arg_overflow
new file mode 100755
index 0000000000..dd5accc051
--- /dev/null
+++ b/lib/stdlib/test/escript_SUITE_data/arg_overflow
@@ -0,0 +1,5 @@
+#! /usr/bin/env escript
+%% -*- erlang -*-
+%%!x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x
+main(_) ->
+ halt(0).
diff --git a/lib/stdlib/test/escript_SUITE_data/linebuf_overflow b/lib/stdlib/test/escript_SUITE_data/linebuf_overflow
new file mode 100755
index 0000000000..33133c1ce9
--- /dev/null
+++ b/lib/stdlib/test/escript_SUITE_data/linebuf_overflow
@@ -0,0 +1,5 @@
+#! /usr/bin/env escript
+%% -*- erlang -*-
+%%!xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+main(_) ->
+ halt(0).
diff --git a/lib/stdlib/vsn.mk b/lib/stdlib/vsn.mk
index 1757d35160..db7954af04 100644
--- a/lib/stdlib/vsn.mk
+++ b/lib/stdlib/vsn.mk
@@ -1 +1 @@
-STDLIB_VSN = 1.17.1
+STDLIB_VSN = 1.17.2
diff --git a/lib/syntax_tools/src/epp_dodger.erl b/lib/syntax_tools/src/epp_dodger.erl
index 6b0f2034f8..9f6f7d815e 100644
--- a/lib/syntax_tools/src/epp_dodger.erl
+++ b/lib/syntax_tools/src/epp_dodger.erl
@@ -809,6 +809,8 @@ tokens_to_string([{atom,_,A} | Ts]) ->
io_lib:write_atom(A) ++ " " ++ tokens_to_string(Ts);
tokens_to_string([{string, _, S} | Ts]) ->
io_lib:write_string(S) ++ " " ++ tokens_to_string(Ts);
+tokens_to_string([{char, _, C} | Ts]) ->
+ io_lib:write_char(C) ++ " " ++ tokens_to_string(Ts);
tokens_to_string([{float, _, F} | Ts]) ->
float_to_list(F) ++ " " ++ tokens_to_string(Ts);
tokens_to_string([{integer, _, N} | Ts]) ->
diff --git a/lib/syntax_tools/src/erl_prettypr.erl b/lib/syntax_tools/src/erl_prettypr.erl
index c2c72d1ed2..7caf0b3db6 100644
--- a/lib/syntax_tools/src/erl_prettypr.erl
+++ b/lib/syntax_tools/src/erl_prettypr.erl
@@ -50,11 +50,15 @@
-type hook() :: 'none'
| fun((erl_syntax:syntaxTree(), _, _) -> prettypr:document()).
+-type clause_t() :: 'case_expr' | 'cond_expr' | 'fun_expr'
+ | 'if_expr' | 'receive_expr' | 'try_expr'
+ | {'function', prettypr:document()}
+ | {'rule', prettypr:document()}.
-record(ctxt, {prec = 0 :: integer(),
sub_indent = 2 :: non_neg_integer(),
break_indent = 4 :: non_neg_integer(),
- clause = undefined,
+ clause = undefined :: clause_t() | 'undefined',
hook = ?NOHOOK :: hook(),
paper = ?PAPER :: integer(),
ribbon = ?RIBBON :: integer(),
@@ -599,9 +603,8 @@ lay_2(Node, Ctxt) ->
case_expr ->
Ctxt1 = reset_prec(Ctxt),
D1 = lay(erl_syntax:case_expr_argument(Node), Ctxt1),
- D2 = lay_clauses(
- erl_syntax:case_expr_clauses(Node),
- case_expr, Ctxt1),
+ D2 = lay_clauses(erl_syntax:case_expr_clauses(Node),
+ case_expr, Ctxt1),
sep([par([follow(text("case"), D1, Ctxt1#ctxt.sub_indent),
text("of")],
Ctxt1#ctxt.break_indent),
@@ -819,9 +822,8 @@ lay_2(Node, Ctxt) ->
receive_expr ->
Ctxt1 = reset_prec(Ctxt),
- D1 = lay_clauses(
- erl_syntax:receive_expr_clauses(Node),
- receive_expr, Ctxt1),
+ D1 = lay_clauses(erl_syntax:receive_expr_clauses(Node),
+ receive_expr, Ctxt1),
D2 = case erl_syntax:receive_expr_timeout(Node) of
none ->
D1;
diff --git a/lib/syntax_tools/src/erl_recomment.erl b/lib/syntax_tools/src/erl_recomment.erl
index 94e760dad7..919e9cfc5d 100644
--- a/lib/syntax_tools/src/erl_recomment.erl
+++ b/lib/syntax_tools/src/erl_recomment.erl
@@ -215,7 +215,8 @@ comment_delta(Text) ->
%% the source file itself, but have been included by preprocessing. This
%% way, comments will not be inserted into such parts by mistake.
--record(filter, {file = undefined, line = 0 :: integer()}).
+-record(filter, {file = undefined :: file:filename() | 'undefined',
+ line = 0 :: integer()}).
filter_forms(Fs) ->
filter_forms(Fs, false, #filter{}).
@@ -721,8 +722,6 @@ tree_node_attrs(#tree{attrs = Attrs}) ->
%% =====================================================================
%% General utility functions
-%% Just the generic "maximum" function
-
%% Return the least positive integer of X and Y, or zero if none of them
%% are positive. (This is necessary for computing minimum source line
%% numbers, since zero (or negative) numbers may occur, but they
diff --git a/lib/syntax_tools/src/erl_syntax_lib.erl b/lib/syntax_tools/src/erl_syntax_lib.erl
index 4808971a59..daef74e874 100644
--- a/lib/syntax_tools/src/erl_syntax_lib.erl
+++ b/lib/syntax_tools/src/erl_syntax_lib.erl
@@ -1134,21 +1134,21 @@ collect_attribute(_, {N, V}, Info) ->
%% Abstract datatype for collecting module information.
--record(forms, {module, exports, module_imports, imports, attributes,
- records, errors, warnings, functions, rules}).
+-record(forms, {module = none :: 'none' | {'value', atom()},
+ exports = [] :: [{atom(), arity()}],
+ module_imports = [] :: [atom()],
+ imports = [] :: [{atom(), [{atom(), arity()}]}],
+ attributes = [] :: [{atom(), term()}],
+ records = [] :: [{atom(), [{atom(), field_default()}]}],
+ errors = [] :: [term()],
+ warnings = [] :: [term()],
+ functions = [] :: [{atom(), arity()}],
+ rules = [] :: [{atom(), arity()}]}).
+
+-type field_default() :: 'none' | erl_syntax:syntaxTree().
new_finfo() ->
- #forms{module = none,
- exports = [],
- module_imports = [],
- imports = [],
- attributes = [],
- records = [],
- errors = [],
- warnings = [],
- functions = [],
- rules = []
- }.
+ #forms{}.
finfo_set_module(Name, Info) ->
case Info#forms.module of
diff --git a/lib/syntax_tools/src/erl_tidy.erl b/lib/syntax_tools/src/erl_tidy.erl
index 021ab18736..1cfdc7234a 100644
--- a/lib/syntax_tools/src/erl_tidy.erl
+++ b/lib/syntax_tools/src/erl_tidy.erl
@@ -935,12 +935,13 @@ hidden_uses_2(Tree, Used) ->
Used
end.
+-type fa() :: {atom(), arity()}.
-type context() :: 'guard_expr' | 'guard_test' | 'normal'.
-record(env, {file :: file:filename(),
- module,
- current,
- imports,
+ module :: atom(),
+ current :: fa(),
+ imports = dict:new() :: dict(),
context = normal :: context(),
verbosity = 1 :: 0 | 1 | 2,
quiet = false :: boolean(),
@@ -951,7 +952,13 @@ hidden_uses_2(Tree, Used) ->
new_guard_tests = true :: boolean(),
old_guard_tests = false :: boolean()}).
--record(st, {varc, used, imported, vars, functions, new_forms, rename}).
+-record(st, {varc :: non_neg_integer(),
+ used = sets:new() :: set(),
+ imported :: set(),
+ vars :: set(),
+ functions :: set(),
+ new_forms = [] :: [erl_syntax:syntaxTree()],
+ rename :: dict()}).
visit_used(Names, Defs, Roots, Imports, Module, Opts) ->
File = proplists:get_value(file, Opts, ""),
diff --git a/lib/syntax_tools/src/igor.erl b/lib/syntax_tools/src/igor.erl
index 702b399615..7ec62f1dba 100644
--- a/lib/syntax_tools/src/igor.erl
+++ b/lib/syntax_tools/src/igor.erl
@@ -1035,7 +1035,12 @@ make_stub(M, Map, Env) ->
%% Removing and/or out-commenting program forms. The returned form
%% sequence tree is not necessarily flat.
--record(filter, {records :: set(), file_attributes, attributes}).
+-type atts() :: 'delete' | 'kill'.
+-type file_atts() :: 'delete' | 'keep' | 'kill'.
+
+-record(filter, {records :: set(),
+ file_attributes :: file_atts(),
+ attributes :: atts()}).
filter_forms(Tree, Env) ->
Forms = erl_syntax:form_list_elements(
@@ -1576,6 +1581,8 @@ alias_expansions_2(Modules, Table) ->
%% ---------------------------------------------------------------------
%% Merging the source code.
+-type map_fun() :: fun(({atom(), integer()}) -> {atom(), integer()}).
+
%% Data structure for code transformation environment.
-record(code, {module :: atom(),
@@ -1586,11 +1593,10 @@ alias_expansions_2(Modules, Table) ->
preserved :: boolean(),
no_headers :: boolean(),
notes :: notes(),
- map, % = ({atom(), int()}) -> {atom(), int()}
- renaming, % = (atom()) -> ({atom(), int()}) ->
- % {atom(), int()}
- expand :: dict(), % = dict({atom(), int()},
- % {atom(), {atom(), int()}})
+ map :: map_fun(),
+ renaming :: fun((atom()) -> map_fun()),
+ expand :: dict(), % = dict({atom(), integer()},
+ % {atom(), {atom(), integer()}})
redirect :: dict() % = dict(atom(), atom())
}).
diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl
index bbbb7883db..2ddffccf5b 100644
--- a/lib/test_server/src/ts_install.erl
+++ b/lib/test_server/src/ts_install.erl
@@ -226,9 +226,11 @@ to_upper(String) ->
String).
word_size() ->
- case erlang:system_info(wordsize) of
- 4 -> "";
- 8 -> "/64"
+ case {erlang:system_info({wordsize,external}),
+ erlang:system_info({wordsize,internal})} of
+ {4,4} -> "";
+ {8,8} -> "/64";
+ {8,4} -> "/Halfword"
end.
linux_dist() ->
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index 91acfdf2b6..ed825a298f 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -1481,7 +1481,23 @@ Other commands:
erlang-font-lock-keywords-3
erlang-font-lock-keywords-4)
nil nil ((?_ . "w")) erlang-beginning-of-clause
- (font-lock-mark-block-function . erlang-mark-clause))))
+ (font-lock-mark-block-function . erlang-mark-clause)
+ (font-lock-syntactic-keywords
+ ;; A dollar sign right before the double quote that ends a
+ ;; string is not a character escape.
+ ;;
+ ;; And a "string" has with a double quote not escaped by a
+ ;; dollar sign, any number of non-backslash non-newline
+ ;; characters or escaped backslashes, a dollar sign
+ ;; (otherwise we wouldn't care) and a double quote. This
+ ;; doesn't match multi-line strings, but this is probably
+ ;; the best we can get, since while font-locking we don't
+ ;; know whether matching started inside a string: limiting
+ ;; search to a single line keeps things sane.
+ . (("\\(?:^\\|[^$]\\)\"\\(?:[^\"\n]\\|\\\\\"\\)*\\(\\$\\)\"" 1 "w")
+ ;; And the dollar sign in $\" escapes two characters, not
+ ;; just one.
+ ("\\(\\$\\)\\\\\\\"" 1 "'"))))))