aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stdlib')
-rw-r--r--lib/stdlib/doc/src/gen_statem.xml167
-rw-r--r--lib/stdlib/doc/src/notes.xml2
-rw-r--r--lib/stdlib/doc/src/sys.xml4
-rw-r--r--lib/stdlib/src/base64.erl67
-rw-r--r--lib/stdlib/src/gen_event.erl2
-rw-r--r--lib/stdlib/src/gen_statem.erl867
-rw-r--r--lib/stdlib/src/qlc.erl6
-rw-r--r--lib/stdlib/src/zip.erl62
-rw-r--r--lib/stdlib/test/gen_statem_SUITE.erl105
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl18
-rw-r--r--lib/stdlib/test/zip_SUITE.erl36
11 files changed, 803 insertions, 533 deletions
diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml
index fd498ee82e..5eb13db1aa 100644
--- a/lib/stdlib/doc/src/gen_statem.xml
+++ b/lib/stdlib/doc/src/gen_statem.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2016</year>
+ <year>2016-2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -587,8 +587,8 @@ handle_event(_, _, State, Data) ->
<name name="state_enter"/>
<desc>
<p>
- If the state machine should use <em>state enter calls</em>
- is selected when starting the <c>gen_statem</c>
+ Whether the state machine should use <em>state enter calls</em>
+ or not is selected when starting the <c>gen_statem</c>
and after code change using the return value from
<seealso marker="#Module:callback_mode/0"><c>Module:callback_mode/0</c></seealso>.
</p>
@@ -606,7 +606,16 @@ handle_event(_, _, State, Data) ->
See
<seealso marker="#Module:StateName/3"><c>Module:StateName/3</c></seealso>
and
- <seealso marker="#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>.
+ <seealso marker="#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>.
+ Such a call can be repeated by returning a
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state</c>
+ </seealso>
+ or
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state_and_data</c>
+ </seealso>
+ tuple from the state callback.
</p>
<p>
If
@@ -625,7 +634,8 @@ handle_event(_, _, State, Data) ->
right before entering the initial state even though this
formally is not a state change.
In this case <c>OldState</c> will be the same as <c>State</c>,
- which can not happen for a subsequent state change.
+ which can not happen for a subsequent state change,
+ but will happen when repeating the state enter call.
</p>
</desc>
</datatype>
@@ -640,7 +650,15 @@ handle_event(_, _, State, Data) ->
<list type="ordered">
<item>
<p>
- If the state changes or is the initial state, and
+ If the state changes, is the initial state,
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state</c>
+ </seealso>
+ or
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state_and_data</c>
+ </seealso>
+ is used, and also
<seealso marker="#type-state_enter"><em>state enter calls</em></seealso>
are used, the <c>gen_statem</c> calls
the new state callback with arguments
@@ -983,6 +1001,33 @@ handle_event(_, _, State, Data) ->
</desc>
</datatype>
<datatype>
+ <name name="init_result"/>
+ <desc>
+ <p>
+ For a succesful initialization,
+ <c><anno>State</anno></c> is the initial
+ <seealso marker="#type-state"><c>state()</c></seealso>
+ and <c><anno>Data</anno></c> the initial server
+ <seealso marker="#type-data"><c>data()</c></seealso>
+ of the <c>gen_statem</c>.
+ </p>
+ <p>
+ The <seealso marker="#type-action"><c>Actions</c></seealso>
+ are executed when entering the first
+ <seealso marker="#type-state">state</seealso> just as for a
+ <seealso marker="#state callback">state callback</seealso>,
+ except that the action <c>postpone</c> is forced to
+ <c>false</c> since there is no event to postpone.
+ </p>
+ <p>
+ For an unsuccesful initialization,
+ <c>{stop,<anno>Reason</anno>}</c>
+ or <c>ignore</c> should be used; see
+ <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>.
+ </p>
+ </desc>
+ </datatype>
+ <datatype>
<name name="state_enter_result"/>
<desc>
<p>
@@ -1068,6 +1113,37 @@ handle_event(_, _, State, Data) ->
<c>{next_state,CurrentState,CurrentData,<anno>Actions</anno>}</c>.
</p>
</item>
+ <tag><c>repeat_state</c></tag>
+ <item>
+ <p>
+ The <c>gen_statem</c> keeps the current state, or
+ does a state transition to the current state if you like,
+ sets <c><anno>NewData</anno></c>,
+ and executes all <c><anno>Actions</anno></c>.
+ If the <c>gen_statem</c> runs with
+ <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>,
+ the state enter call is repeated, see type
+ <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>,
+ otherwise <c>repeat_state</c> is the same as
+ <c>keep_state</c>.
+ </p>
+ </item>
+ <tag><c>repeat_state_and_data</c></tag>
+ <item>
+ <p>
+ The <c>gen_statem</c> keeps the current state and data, or
+ does a state transition to the current state if you like,
+ and executes all <c><anno>Actions</anno></c>.
+ This is the same as
+ <c>{repeat_state,CurrentData,<anno>Actions</anno>}</c>.
+ If the <c>gen_statem</c> runs with
+ <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>,
+ the state enter call is repeated, see type
+ <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>,
+ otherwise <c>repeat_state_and_data</c> is the same as
+ <c>keep_state_and_data</c>.
+ </p>
+ </item>
<tag><c>stop</c></tag>
<item>
<p>
@@ -1609,29 +1685,33 @@ handle_event(_, _, State, Data) ->
It is recommended to use an atom as <c>Reason</c> since
it will be wrapped in an <c>{error,Reason}</c> tuple.
</p>
+ <p>
+ Also note when upgrading a <c>gen_statem</c>,
+ this function and hence
+ the <c>Change={advanced,Extra}</c> parameter in the
+ <seealso marker="sasl:appup"><c>appup</c></seealso> file
+ is not only needed to update the internal state
+ or to act on the <c>Extra</c> argument.
+ It is also needed if an upgrade or downgrade should change
+ <seealso marker="#type-callback_mode"><em>callback mode</em></seealso>,
+ or else the callback mode after the code change
+ will not be honoured,
+ most probably causing a server crash.
+ </p>
</desc>
</func>
<func>
- <name>Module:init(Args) -> Result</name>
+ <name>Module:init(Args) -> Result(StateType)</name>
<fsummary>
Optional function for initializing process and internal state.
</fsummary>
<type>
<v>Args = term()</v>
- <v>Result = {ok,State,Data}</v>
- <v>&nbsp;| {ok,State,Data,Actions}</v>
- <v>&nbsp;| {stop,Reason} | ignore</v>
- <v>State = <seealso marker="#type-state">state()</seealso></v>
- <v>
- Data = <seealso marker="#type-data">data()</seealso>
- </v>
<v>
- Actions =
- [<seealso marker="#type-action">action()</seealso>] |
- <seealso marker="#type-action">action()</seealso>
+ Result(StateType) =
+ <seealso marker="#type-init_result">init_result(StateType)</seealso>
</v>
- <v>Reason = term()</v>
</type>
<desc>
<marker id="Module:init-1"/>
@@ -1644,30 +1724,9 @@ handle_event(_, _, State, Data) ->
the implementation state and server data.
</p>
<p>
- <c>Args</c> is the <c>Args</c> argument provided to the start
+ <c>Args</c> is the <c>Args</c> argument provided to that start
function.
</p>
- <p>
- If the initialization is successful, the function is to
- return <c>{ok,State,Data}</c> or
- <c>{ok,State,Data,Actions}</c>.
- <c>State</c> is the initial
- <seealso marker="#type-state"><c>state()</c></seealso>
- and <c>Data</c> the initial server
- <seealso marker="#type-data"><c>data()</c></seealso>.
- </p>
- <p>
- The <seealso marker="#type-action"><c>Actions</c></seealso>
- are executed when entering the first
- <seealso marker="#type-state">state</seealso> just as for a
- <seealso marker="#state callback">state callback</seealso>.
- </p>
- <p>
- If the initialization fails,
- the function is to return <c>{stop,Reason}</c>
- or <c>ignore</c>; see
- <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>.
- </p>
<note>
<p>
This callback is optional, so a callback module does not need
@@ -1873,22 +1932,33 @@ handle_event(_, _, State, Data) ->
<seealso marker="#type-enter_action">actions</seealso>
that may be returned:
<seealso marker="#type-postpone"><c>postpone()</c></seealso>
- and
+ is not allowed since a <em>state enter call</em> is not
+ an event so there is no event to postpone, and
<seealso marker="#type-action"><c>{next_event,_,_}</c></seealso>
- are not allowed.
+ is not allowed since using <em>state enter calls</em>
+ should not affect how events are consumed and produced.
You may also not change states from this call.
Should you return <c>{next_state,NextState, ...}</c>
with <c>NextState =/= State</c> the <c>gen_statem</c> crashes.
- You are advised to use <c>{keep_state,...}</c> or
- <c>keep_state_and_data</c>.
+ It is possible to use <c>{repeat_state, ...}</c>,
+ <c>{repeat_state_and_data,_}</c> or
+ <c>repeat_state_and_data</c> but all of them makes little
+ sense since you immediately will be called again with a new
+ <em>state enter call</em> making this just a weird way
+ of looping, and there are better ways to loop in Erlang.
+ You are advised to use <c>{keep_state,...}</c>,
+ <c>{keep_state_and_data,_}</c> or
+ <c>keep_state_and_data</c> since you can not change states
+ from a <em>state enter call</em> anyway.
</p>
<p>
Note the fact that you can use
<seealso marker="erts:erlang#throw/1"><c>throw</c></seealso>
to return the result, which can be useful.
For example to bail out with <c>throw(keep_state_and_data)</c>
- from deep within complex code that is in no position to
- return <c>{next_state,State,Data}</c>.
+ from deep within complex code that can not
+ return <c>{next_state,State,Data}</c> because
+ <c>State</c> or <c>Data</c> is no longer in scope.
</p>
</desc>
</func>
@@ -1903,6 +1973,11 @@ handle_event(_, _, State, Data) ->
<v>Ignored = term()</v>
</type>
<desc>
+ <note>
+ <p>This callback is optional, so callback modules need not
+ export it. The <c>gen_statem</c> module provides a default
+ implementation without cleanup.</p>
+ </note>
<p>
This function is called by a <c>gen_statem</c>
when it is about to terminate. It is to be the opposite of
diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml
index 0143686bb2..0e8bf3d27c 100644
--- a/lib/stdlib/doc/src/notes.xml
+++ b/lib/stdlib/doc/src/notes.xml
@@ -3163,7 +3163,7 @@
<p>
Two bugs in io:format for ~F.~Ps has been corrected. When
length(S) >= abs(F) > P, the precision P was incorrectly
- ignored. When F == P > lenght(S) the result was
+ ignored. When F == P > length(S) the result was
incorrectly left adjusted. Bug found by Ali Yakout who
also provided a fix.</p>
<p>
diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml
index 9091a46df9..45171f814d 100644
--- a/lib/stdlib/doc/src/sys.xml
+++ b/lib/stdlib/doc/src/sys.xml
@@ -83,8 +83,8 @@
<p>If the modules used to implement the process change dynamically
during runtime, the process must understand one more message. An
example is the <seealso marker="gen_event"><c>gen_event</c></seealso>
- processes. The message is <c>{get_modules, From}</c>.
- The reply to this message is <c>From ! {modules, Modules}</c>, where
+ processes. The message is <c>{_Label, {From, Ref}, get_modules}</c>.
+ The reply to this message is <c>From ! {Ref, Modules}</c>, where
<c>Modules</c> is a list of the currently active modules in the
process.</p>
<p>This message is used by the release handler to find which
diff --git a/lib/stdlib/src/base64.erl b/lib/stdlib/src/base64.erl
index bf259e6691..0c8d817910 100644
--- a/lib/stdlib/src/base64.erl
+++ b/lib/stdlib/src/base64.erl
@@ -219,38 +219,49 @@ mime_decode_binary(Result, <<0:8,T/bits>>) ->
mime_decode_binary(Result, T);
mime_decode_binary(Result0, <<C:8,T/bits>>) ->
case element(C, ?DECODE_MAP) of
- Bits when is_integer(Bits) ->
- mime_decode_binary(<<Result0/bits,Bits:6>>, T);
- eq ->
- case tail_contains_more(T, false) of
- {<<>>, Eq} ->
- %% No more valid data.
- case bit_size(Result0) rem 8 of
- 0 ->
- %% '====' is not uncommon.
- Result0;
- 4 when Eq ->
- %% enforce at least one more '=' only ignoring illegals and spacing
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:4>> = Result0,
- Result;
- 2 ->
- %% remove 2 bits
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:2>> = Result0,
- Result
- end;
- {More, _} ->
- %% More valid data, skip the eq as invalid
- mime_decode_binary(Result0, More)
- end;
- _ ->
- mime_decode_binary(Result0, T)
+ Bits when is_integer(Bits) ->
+ mime_decode_binary(<<Result0/bits,Bits:6>>, T);
+ eq ->
+ mime_decode_binary_after_eq(Result0, T, false);
+ _ ->
+ mime_decode_binary(Result0, T)
end;
-mime_decode_binary(Result, <<>>) ->
+mime_decode_binary(Result, _) ->
true = is_binary(Result),
Result.
+mime_decode_binary_after_eq(Result, <<0:8,T/bits>>, Eq) ->
+ mime_decode_binary_after_eq(Result, T, Eq);
+mime_decode_binary_after_eq(Result0, <<C:8,T/bits>>, Eq) ->
+ case element(C, ?DECODE_MAP) of
+ bad ->
+ mime_decode_binary_after_eq(Result0, T, Eq);
+ ws ->
+ mime_decode_binary_after_eq(Result0, T, Eq);
+ eq ->
+ mime_decode_binary_after_eq(Result0, T, true);
+ Bits when is_integer(Bits) ->
+ %% More valid data, skip the eq as invalid
+ mime_decode_binary(<<Result0/bits,Bits:6>>, T)
+ end;
+mime_decode_binary_after_eq(Result0, <<>>, Eq) ->
+ %% No more valid data.
+ case bit_size(Result0) rem 8 of
+ 0 ->
+ %% '====' is not uncommon.
+ Result0;
+ 4 when Eq ->
+ %% enforce at least one more '=' only ignoring illegals and spacing
+ Split = byte_size(Result0) - 1,
+ <<Result:Split/bytes,_:4>> = Result0,
+ Result;
+ 2 ->
+ %% remove 2 bits
+ Split = byte_size(Result0) - 1,
+ <<Result:Split/bytes,_:2>> = Result0,
+ Result
+ end.
+
decode([], A) -> A;
decode([$=,$=,C2,C1|Cs], A) ->
Bits2x6 = (b64d(C1) bsl 18) bor (b64d(C2) bsl 12),
diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl
index 4839fe4f2c..0aebf1bdc5 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -778,7 +778,7 @@ stop_handlers([], _) ->
[].
%% Message from the release_handler.
-%% The list of modules got to be a set !
+%% The list of modules got to be a set, i.e. no duplicate elements!
get_modules(MSL) ->
Mods = [Handler#handler.module || Handler <- MSL],
ordsets:to_list(ordsets:from_list(Mods)).
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
index 018aca90e6..cacc932ec4 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2016. All Rights Reserved.
+%% Copyright Ericsson AB 2016-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -47,15 +47,17 @@
%% Type exports for templates and callback modules
-export_type(
[event_type/0,
- init_result/0,
callback_mode_result/0,
- state_function_result/0,
- handle_event_result/0,
+ init_result/1,
state_enter_result/1,
event_handler_result/1,
reply_action/0,
enter_action/0,
action/0]).
+%% Old types, not advertised
+-export_type(
+ [state_function_result/0,
+ handle_event_result/0]).
%% Type that is exported just to be documented
-export_type([transition_option/0]).
@@ -143,9 +145,10 @@
{'reply', % Reply to a caller
From :: from(), Reply :: term()}.
--type init_result() ::
- {ok, state(), data()} |
- {ok, state(), data(), [action()] | action()} |
+-type init_result(StateType) ::
+ {ok, State :: StateType, Data :: data()} |
+ {ok, State :: StateType, Data :: data(),
+ Actions :: [action()] | action()} |
'ignore' |
{'stop', Reason :: term()}.
@@ -182,12 +185,23 @@
'keep_state_and_data' | % {keep_state_and_data,[]}
{'keep_state_and_data', % Keep state and data -> only actions
Actions :: [ActionType] | ActionType} |
+ %%
+ {'repeat_state', % {repeat_state,NewData,[]}
+ NewData :: data()} |
+ {'repeat_state', % Repeat state, change data
+ NewData :: data(),
+ Actions :: [ActionType] | ActionType} |
+ 'repeat_state_and_data' | % {repeat_state_and_data,[]}
+ {'repeat_state_and_data', % Repeat state and data -> only actions
+ Actions :: [ActionType] | ActionType} |
+ %%
'stop' | % {stop,normal}
{'stop', % Stop the server
Reason :: term()} |
{'stop', % Stop the server
Reason :: term(),
NewData :: data()} |
+ %%
{'stop_and_reply', % Reply then stop the server
Reason :: term(),
Replies :: [reply_action()] | reply_action()} |
@@ -201,7 +215,7 @@
%% the server is not running until this function has returned
%% an {ok, ...} tuple. Thereafter the state callbacks are called
%% for all events to this server.
--callback init(Args :: term()) -> init_result().
+-callback init(Args :: term()) -> init_result(state()).
%% This callback shall return the callback mode of the callback module.
%%
@@ -275,6 +289,8 @@
-optional_callbacks(
[init/1, % One may use enter_loop/5,6,7 instead
format_status/2, % Has got a default implementation
+ terminate/3, % Has got a default implementation
+ code_change/4, % Only needed by advanced soft upgrade
%%
state_name/3, % Example for callback_mode() =:= state_functions:
%% there has to be a StateName/3 callback function
@@ -304,12 +320,16 @@ event_type({call,From}) ->
from(From);
event_type(Type) ->
case Type of
+ {call,From} ->
+ from(From);
cast ->
true;
info ->
true;
timeout ->
true;
+ state_timeout ->
+ true;
internal ->
true;
_ ->
@@ -588,6 +608,22 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
true ->
[Actions,{postpone,false}]
end,
+ TimerRefs = #{},
+ %% Key: timer ref
+ %% Value: the timer type i.e the timer's event type
+ %%
+ TimerTypes = #{},
+ %% Key: timer type i.e the timer's event type
+ %% Value: timer ref
+ %%
+ %% We add a timer to both timer_refs and timer_types
+ %% when we start it. When we request an asynchronous
+ %% timer cancel we remove it from timer_types. When
+ %% the timer cancel message arrives we remove it from
+ %% timer_refs.
+ %%
+ Hibernate = false,
+ CancelTimers = 0,
S = #{
callback_mode => undefined,
state_enter => false,
@@ -596,25 +632,25 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
state => State,
data => Data,
postponed => P,
- %% The rest of the fields are set from to the arguments to
- %% loop_event_actions/10 when it finally loops back to loop/3
- %% in loop_events/10
%%
- %% Marker for initial state, cleared immediately when used
- init_state => true
+ %% The following fields are finally set from to the arguments to
+ %% loop_event_actions/9 when it finally loops back to loop/3
+ %% in loop_event_result/11
+ timer_refs => TimerRefs,
+ timer_types => TimerTypes,
+ hibernate => Hibernate,
+ cancel_timers => CancelTimers
},
NewDebug = sys_debug(Debug, S, State, {enter,Event,State}),
case call_callback_mode(S) of
{ok,NewS} ->
- TimerRefs = #{},
- TimerTypes = #{},
loop_event_actions(
- Parent, NewDebug, NewS, TimerRefs, TimerTypes,
- Events, Event, State, Data, NewActions);
+ Parent, NewDebug, NewS,
+ Events, Event, State, Data, NewActions, true);
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- NewDebug, S, [Event|Events])
+ Class, Reason, Stacktrace, NewDebug,
+ S, [Event|Events])
end.
%%%==========================================================================
@@ -683,9 +719,7 @@ system_continue(Parent, Debug, S) ->
loop(Parent, Debug, S).
system_terminate(Reason, _Parent, Debug, S) ->
- terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S, []).
+ terminate(exit, Reason, ?STACKTRACE(), Debug, S, []).
system_code_change(
#{module := Module,
@@ -796,23 +830,22 @@ wakeup_from_hibernate(Parent, Debug, S) ->
%% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3
%% Entry point for system_continue/3
-loop(Parent, Debug, #{hibernate := Hibernate} = S) ->
- case Hibernate of
- true ->
- %% Does not return but restarts process at
- %% wakeup_from_hibernate/3 that jumps to loop_receive/3
- proc_lib:hibernate(
- ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]),
- error(
- {should_not_have_arrived_here_but_instead_in,
- {wakeup_from_hibernate,3}});
- false ->
- loop_receive(Parent, Debug, S)
- end.
+loop(Parent, Debug, #{hibernate := true, cancel_timers := 0} = S) ->
+ loop_hibernate(Parent, Debug, S);
+loop(Parent, Debug, S) ->
+ loop_receive(Parent, Debug, S).
+
+loop_hibernate(Parent, Debug, S) ->
+ %% Does not return but restarts process at
+ %% wakeup_from_hibernate/3 that jumps to loop_receive/3
+ proc_lib:hibernate(
+ ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]),
+ error(
+ {should_not_have_arrived_here_but_instead_in,
+ {wakeup_from_hibernate,3}}).
%% Entry point for wakeup_from_hibernate/3
-loop_receive(
- Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) ->
+loop_receive(Parent, Debug, S) ->
receive
Msg ->
case Msg of
@@ -821,30 +854,87 @@ loop_receive(
%% Does not return but tail recursively calls
%% system_continue/3 that jumps to loop/3
sys:handle_system_msg(
- Req, Pid, Parent, ?MODULE, Debug, S, Hibernate);
+ Req, Pid, Parent, ?MODULE, Debug, S,
+ Hibernate);
{'EXIT',Parent,Reason} = EXIT ->
- %% EXIT is not a 2-tuple and therefore
- %% not an event and has no event_type(),
- %% but this will stand out in the crash report...
- terminate(
- exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]);
+ %% EXIT is not a 2-tuple therefore
+ %% not an event but this will stand out
+ %% in the crash report...
+ Q = [EXIT],
+ terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q);
{timeout,TimerRef,TimerMsg} ->
+ #{timer_refs := TimerRefs,
+ timer_types := TimerTypes,
+ hibernate := Hibernate} = S,
case TimerRefs of
#{TimerRef := TimerType} ->
- Event = {TimerType,TimerMsg},
- %% Unregister the triggered timeout
+ %% We know of this timer; is it a running
+ %% timer or a timer being cancelled that
+ %% managed to send a late timeout message?
+ case TimerTypes of
+ #{TimerType := TimerRef} ->
+ %% The timer type maps back to this
+ %% timer ref, so it was a running timer
+ Event = {TimerType,TimerMsg},
+ %% Unregister the triggered timeout
+ NewTimerRefs =
+ maps:remove(TimerRef, TimerRefs),
+ NewTimerTypes =
+ maps:remove(TimerType, TimerTypes),
+ loop_receive_result(
+ Parent, Debug,
+ S#{
+ timer_refs := NewTimerRefs,
+ timer_types := NewTimerTypes},
+ Hibernate,
+ Event);
+ _ ->
+ %% This was a late timeout message
+ %% from timer being cancelled, so
+ %% ignore it and expect a cancel_timer
+ %% msg shortly
+ loop_receive(Parent, Debug, S)
+ end;
+ _ ->
+ %% Not our timer; present it as an event
+ Event = {info,Msg},
loop_receive_result(
- Parent, Debug, S,
- maps:remove(TimerRef, TimerRefs),
- maps:remove(TimerType, TimerTypes),
- Event);
+ Parent, Debug, S, Hibernate, Event)
+ end;
+ {cancel_timer,TimerRef,_} ->
+ #{timer_refs := TimerRefs,
+ cancel_timers := CancelTimers,
+ hibernate := Hibernate} = S,
+ case TimerRefs of
+ #{TimerRef := _} ->
+ %% We must have requested a cancel
+ %% of this timer so it is already
+ %% removed from TimerTypes
+ NewTimerRefs =
+ maps:remove(TimerRef, TimerRefs),
+ NewCancelTimers = CancelTimers - 1,
+ NewS =
+ S#{
+ timer_refs := NewTimerRefs,
+ cancel_timers := NewCancelTimers},
+ if
+ Hibernate =:= true, NewCancelTimers =:= 0 ->
+ %% No more cancel_timer msgs to expect;
+ %% we can hibernate
+ loop_hibernate(Parent, Debug, NewS);
+ NewCancelTimers >= 0 -> % Assert
+ loop_receive(Parent, Debug, NewS)
+ end;
_ ->
+ %% Not our cancel_timer msg;
+ %% present it as an event
Event = {info,Msg},
loop_receive_result(
- Parent, Debug, S,
- TimerRefs, TimerTypes, Event)
+ Parent, Debug, S, Hibernate, Event)
end;
_ ->
+ %% External msg
+ #{hibernate := Hibernate} = S,
Event =
case Msg of
{'$gen_call',From,Request} ->
@@ -855,208 +945,212 @@ loop_receive(
{info,Msg}
end,
loop_receive_result(
- Parent, Debug, S,
- TimerRefs, TimerTypes, Event)
+ Parent, Debug, S, Hibernate, Event)
end
end.
loop_receive_result(
- Parent, Debug, #{state := State} = S,
- TimerRefs, TimerTypes, Event) ->
- %% The fields 'timer_refs', 'timer_types' and 'hibernate'
- %% are now invalid in state map S - they will be recalculated
- %% and restored when we return to loop/3
- %%
+ Parent, Debug,
+ #{state := State,
+ timer_types := TimerTypes, cancel_timers := CancelTimers} = S,
+ Hibernate, Event) ->
+ %% From now the 'hibernate' field in S is invalid
+ %% and will be restored when looping back
+ %% in loop_event_result/11
NewDebug = sys_debug(Debug, S, State, {in,Event}),
- %% Here the queue of not yet handled events is created
+ %% Here is the queue of not yet handled events created
Events = [],
- Hibernate = false,
- loop_event(
- Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, Hibernate).
+ %% Cancel any running event timer
+ case
+ cancel_timer_by_type(timeout, TimerTypes, CancelTimers)
+ of
+ {_,CancelTimers} ->
+ %% No timer cancelled
+ loop_event(Parent, NewDebug, S, Events, Event, Hibernate);
+ {NewTimerTypes,NewCancelTimers} ->
+ %% The timer is removed from NewTimerTypes but
+ %% remains in TimerRefs until we get
+ %% the cancel_timer msg
+ NewS =
+ S#{
+ timer_types := NewTimerTypes,
+ cancel_timers := NewCancelTimers},
+ loop_event(Parent, NewDebug, NewS, Events, Event, Hibernate)
+ end.
%% Entry point for handling an event, received or enqueued
loop_event(
- Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes,
+ Parent, Debug,
+ #{state := State, data := Data} = S,
Events, {Type,Content} = Event, Hibernate) ->
%%
- %% If Hibernate is true here it can only be
+ %% If (this old) Hibernate is true here it can only be
%% because it was set from an event action
- %% and we did not go into hibernation since there
- %% were events in queue, so we do what the user
+ %% and we did not go into hibernation since there were
+ %% events in queue, so we do what the user
%% might rely on i.e collect garbage which
%% would have happened if we actually hibernated
%% and immediately was awakened
Hibernate andalso garbage_collect(),
case call_state_function(S, Type, Content, State, Data) of
{ok,Result,NewS} ->
- %% Cancel event timeout
- {NewTimerRefs,NewTimerTypes} =
- cancel_timer_by_type(
- timeout, TimerRefs, TimerTypes),
- {NewData,NextState,Actions} =
+ {NextState,NewData,Actions,EnterCall} =
parse_event_result(
- true, Debug, NewS, Result,
- Events, Event, State, Data),
+ true, Debug, NewS,
+ Events, Event, State, Data, Result),
loop_event_actions(
- Parent, Debug, S, NewTimerRefs, NewTimerTypes,
- Events, Event, NextState, NewData, Actions);
+ Parent, Debug, NewS,
+ Events, Event, NextState, NewData, Actions, EnterCall);
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace, Debug, S, [Event|Events])
+ Class, Reason, Stacktrace, Debug, S,
+ [Event|Events])
end.
loop_event_actions(
Parent, Debug,
- #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData, Actions) ->
+ #{state := State, state_enter := StateEnter} = S,
+ Events, Event, NextState, NewData,
+ Actions, EnterCall) ->
+ %% Hibernate is reborn here as false being
+ %% the default value from parse_actions/4
case parse_actions(Debug, S, State, Actions) of
{ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} ->
if
- StateEnter, NextState =/= State ->
+ StateEnter, EnterCall ->
loop_event_enter(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Parent, NewDebug, S,
Events, Event, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR);
- StateEnter ->
- case maps:is_key(init_state, S) of
- true ->
- %% Avoid infinite loop in initial state
- %% with state entry events
- NewS = maps:remove(init_state, S),
- loop_event_enter(
- Parent, NewDebug, NewS, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData,
- Hibernate, TimeoutsR, Postpone, NextEventsR);
- false ->
- loop_event_result(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData,
- Hibernate, TimeoutsR, Postpone, NextEventsR)
- end;
true ->
loop_event_result(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Parent, NewDebug, S,
Events, Event, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR)
end;
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- Debug, S#{data := NewData}, [Event|Events])
+ Class, Reason, Stacktrace, Debug, S,
+ [Event|Events])
end.
loop_event_enter(
- Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes,
+ Parent, Debug, #{state := State} = S,
Events, Event, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR) ->
case call_state_function(S, enter, State, NextState, NewData) of
{ok,Result,NewS} ->
- {NewerData,_,Actions} =
- parse_event_result(
- false, Debug, NewS, Result,
- Events, Event, NextState, NewData),
- loop_event_enter_actions(
- Parent, Debug, NewS, TimerRefs, TimerTypes,
- Events, Event, NextState, NewerData,
- Hibernate, TimeoutsR, Postpone, NextEventsR, Actions);
+ case parse_event_result(
+ false, Debug, NewS,
+ Events, Event, NextState, NewData, Result) of
+ {_,NewerData,Actions,EnterCall} ->
+ loop_event_enter_actions(
+ Parent, Debug, NewS,
+ Events, Event, NextState, NewerData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR,
+ Actions, EnterCall)
+ end;
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- Debug, S#{state := NextState, data := NewData},
+ Class, Reason, Stacktrace, Debug,
+ S#{
+ state := NextState,
+ data := NewData,
+ hibernate := Hibernate},
[Event|Events])
end.
loop_event_enter_actions(
- Parent, Debug, S, TimerRefs, TimerTypes,
+ Parent, Debug, #{state_enter := StateEnter} = S,
Events, Event, NextState, NewData,
- Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) ->
+ Hibernate, TimeoutsR, Postpone, NextEventsR,
+ Actions, EnterCall) ->
case
parse_enter_actions(
- Debug, S, NextState, Actions,
- Hibernate, TimeoutsR)
+ Debug, S, NextState, Actions, Hibernate, TimeoutsR)
of
{ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} ->
- loop_event_result(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData,
- NewHibernate, NewTimeoutsR, Postpone, NextEventsR);
+ if
+ StateEnter, EnterCall ->
+ loop_event_enter(
+ Parent, NewDebug, S,
+ Events, Event, NextState, NewData,
+ NewHibernate, NewTimeoutsR, Postpone, NextEventsR);
+ true ->
+ loop_event_result(
+ Parent, NewDebug, S,
+ Events, Event, NextState, NewData,
+ NewHibernate, NewTimeoutsR, Postpone, NextEventsR)
+ end;
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- Debug, S#{state := NextState, data := NewData},
+ Class, Reason, Stacktrace, Debug,
+ S#{
+ state := NextState,
+ data := NewData,
+ hibernate := Hibernate},
[Event|Events])
end.
loop_event_result(
- Parent, Debug,
- #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0,
- Events, Event, NextState, NewData,
+ Parent, Debug_0,
+ #{state := State, postponed := P_0,
+ timer_refs := TimerRefs_0, timer_types := TimerTypes_0,
+ cancel_timers := CancelTimers_0} = S_0,
+ Events_0, Event_0, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR) ->
%%
%% All options have been collected and next_events are buffered.
%% Do the actual state transition.
%%
- {NewDebug,P_1} = % Move current event to postponed if Postpone
+ {Debug_1,P_1} = % Move current event to postponed if Postpone
case Postpone of
true ->
- {sys_debug(Debug, S, State, {postpone,Event,State}),
- [Event|P_0]};
+ {sys_debug(Debug_0, S_0, State, {postpone,Event_0,State}),
+ [Event_0|P_0]};
false ->
- {sys_debug(Debug, S, State, {consume,Event,State}),
+ {sys_debug(Debug_0, S_0, State, {consume,Event_0,State}),
P_0}
end,
- {Events_1,NewP,{TimerRefs_1,TimerTypes_1}} =
+ {Events_1,P_2,{TimerTypes_1,CancelTimers_1}} =
%% Move all postponed events to queue and cancel the
%% state timeout if the state changes
if
NextState =:= State ->
- {Events,P_1,{TimerRefs_0,TimerTypes_0}};
+ {Events_0,P_1,{TimerTypes_0,CancelTimers_0}};
true ->
- {lists:reverse(P_1, Events),[],
+ {lists:reverse(P_1, Events_0),
+ [],
cancel_timer_by_type(
- state_timeout, TimerRefs_0, TimerTypes_0)}
+ state_timeout, TimerTypes_0, CancelTimers_0)}
+ %% The state timer is removed from TimerTypes_1
+ %% but remains in TimerRefs_0 until we get
+ %% the cancel_timer msg
end,
- {TimerRefs_2,TimerTypes_2,TimeoutEvents} =
- %% Stop and start timers non-event timers
- parse_timers(TimerRefs_1, TimerTypes_1, TimeoutsR),
+ {TimerRefs_2,TimerTypes_2,CancelTimers_2,TimeoutEvents} =
+ %% Stop and start non-event timers
+ parse_timers(TimerRefs_0, TimerTypes_1, CancelTimers_1, TimeoutsR),
%% Place next events last in reversed queue
Events_2R = lists:reverse(Events_1, NextEventsR),
%% Enqueue immediate timeout events and start event timer
- {NewTimerRefs,NewTimerTypes,Events_3R} =
- process_timeout_events(
- TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R),
- NewEvents = lists:reverse(Events_3R),
- loop_events(
- Parent, NewDebug, S, NewTimerRefs, NewTimerTypes,
- NewEvents, Hibernate, NextState, NewData, NewP).
-
-%% Loop until out of enqueued events
-%%
-loop_events(
- Parent, Debug, S, TimerRefs, TimerTypes,
- [] = _Events, Hibernate, State, Data, P) ->
- %% Update S and loop back to loop/3 to receive a new event
- NewS =
- S#{
- state := State,
- data := Data,
- postponed := P,
- hibernate => Hibernate,
- timer_refs => TimerRefs,
- timer_types => TimerTypes},
- loop(Parent, Debug, NewS);
-loop_events(
- Parent, Debug, S, TimerRefs, TimerTypes,
- [Event|Events], Hibernate, State, Data, P) ->
- %% Update S and continue with enqueued events
- NewS =
- S#{
- state := State,
- data := Data,
- postponed := P},
- loop_event(
- Parent, Debug, NewS, TimerRefs, TimerTypes, Events, Event, Hibernate).
-
+ Events_3R = prepend_timeout_events(TimeoutEvents, Events_2R),
+ S_1 =
+ S_0#{
+ state := NextState,
+ data := NewData,
+ postponed := P_2,
+ timer_refs := TimerRefs_2,
+ timer_types := TimerTypes_2,
+ cancel_timers := CancelTimers_2,
+ hibernate := Hibernate},
+ case lists:reverse(Events_3R) of
+ [] ->
+ %% Get a new event
+ loop(Parent, Debug_1, S_1);
+ [Event|Events] ->
+ %% Loop until out of enqueued events
+ loop_event(Parent, Debug_1, S_1, Events, Event, Hibernate)
+ end.
%%---------------------------------------------------------------------------
@@ -1069,19 +1163,6 @@ call_callback_mode(#{module := Module} = S) ->
catch
CallbackMode ->
callback_mode_result(S, CallbackMode);
- error:undef ->
- %% Process undef to check for the simple mistake
- %% of calling a nonexistent state function
- %% to make the undef more precise
- case erlang:get_stacktrace() of
- [{Module,callback_mode,[]=Args,_}
- |Stacktrace] ->
- {error,
- {undef_callback,{Module,callback_mode,Args}},
- Stacktrace};
- Stacktrace ->
- {error,undef,Stacktrace}
- end;
Class:Reason ->
{Class,Reason,erlang:get_stacktrace()}
end.
@@ -1126,8 +1207,7 @@ parse_callback_mode(_, _CBMode, StateEnter) ->
call_state_function(
- #{callback_mode := undefined} = S,
- Type, Content, State, Data) ->
+ #{callback_mode := undefined} = S, Type, Content, State, Data) ->
case call_callback_mode(S) of
{ok,NewS} ->
call_state_function(NewS, Type, Content, State, Data);
@@ -1135,13 +1215,12 @@ call_state_function(
Error
end;
call_state_function(
- #{callback_mode := CallbackMode,
- module := Module} = S,
+ #{callback_mode := CallbackMode, module := Module} = S,
Type, Content, State, Data) ->
try
case CallbackMode of
state_functions ->
- erlang:apply(Module, State, [Type,Content,Data]);
+ Module:State(Type, Content, Data);
handle_event_function ->
Module:handle_event(Type, Content, State, Data)
end
@@ -1151,41 +1230,6 @@ call_state_function(
catch
Result ->
{ok,Result,S};
- error:badarg ->
- case erlang:get_stacktrace() of
- [{erlang,apply,
- [Module,State,[Type,Content,Data]=Args],
- _}
- |Stacktrace]
- when CallbackMode =:= state_functions ->
- %% We get here e.g if apply fails
- %% due to State not being an atom
- {error,
- {undef_state_function,{Module,State,Args}},
- Stacktrace};
- Stacktrace ->
- {error,badarg,Stacktrace}
- end;
- error:undef ->
- %% Process undef to check for the simple mistake
- %% of calling a nonexistent state function
- %% to make the undef more precise
- case erlang:get_stacktrace() of
- [{Module,State,[Type,Content,Data]=Args,_}
- |Stacktrace]
- when CallbackMode =:= state_functions ->
- {error,
- {undef_state_function,{Module,State,Args}},
- Stacktrace};
- [{Module,handle_event,[Type,Content,State,Data]=Args,_}
- |Stacktrace]
- when CallbackMode =:= handle_event_function ->
- {error,
- {undef_state_function,{Module,handle_event,Args}},
- Stacktrace};
- Stacktrace ->
- {error,undef,Stacktrace}
- end;
Class:Reason ->
{Class,Reason,erlang:get_stacktrace()}
end.
@@ -1193,65 +1237,83 @@ call_state_function(
%% Interpret all callback return variants
parse_event_result(
- AllowStateChange, Debug, S, Result, Events, Event, State, Data) ->
+ AllowStateChange, Debug, S,
+ Events, Event, State, Data, Result) ->
case Result of
stop ->
terminate(
- exit, normal, ?STACKTRACE(), Debug, S, [Event|Events]);
+ exit, normal, ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events]);
{stop,Reason} ->
terminate(
- exit, Reason, ?STACKTRACE(), Debug, S, [Event|Events]);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events]);
{stop,Reason,NewData} ->
terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S#{data := NewData}, [Event|Events]);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := NewData},
+ [Event|Events]);
+ %%
{stop_and_reply,Reason,Replies} ->
- Q = [Event|Events],
reply_then_terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S, Q, Replies);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events], Replies);
{stop_and_reply,Reason,Replies,NewData} ->
- Q = [Event|Events],
reply_then_terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S#{data := NewData}, Q, Replies);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := NewData},
+ [Event|Events], Replies);
+ %%
{next_state,State,NewData} ->
- {NewData,State,[]};
+ {State,NewData,[],false};
{next_state,NextState,NewData} when AllowStateChange ->
- {NewData,NextState,[]};
+ {NextState,NewData,[],true};
{next_state,State,NewData,Actions} ->
- {NewData,State,Actions};
+ {State,NewData,Actions,false};
{next_state,NextState,NewData,Actions} when AllowStateChange ->
- {NewData,NextState,Actions};
+ {NextState,NewData,Actions,true};
+ %%
{keep_state,NewData} ->
- {NewData,State,[]};
+ {State,NewData,[],false};
{keep_state,NewData,Actions} ->
- {NewData,State,Actions};
+ {State,NewData,Actions,false};
keep_state_and_data ->
- {Data,State,[]};
+ {State,Data,[],false};
{keep_state_and_data,Actions} ->
- {Data,State,Actions};
+ {State,Data,Actions,false};
+ %%
+ {repeat_state,NewData} ->
+ {State,NewData,[],true};
+ {repeat_state,NewData,Actions} ->
+ {State,NewData,Actions,true};
+ repeat_state_and_data ->
+ {State,Data,[],true};
+ {repeat_state_and_data,Actions} ->
+ {State,Data,Actions,true};
+ %%
_ ->
terminate(
error,
{bad_return_from_state_function,Result},
- ?STACKTRACE(),
- Debug, S, [Event|Events])
+ ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events])
end.
-parse_enter_actions(
- Debug, S, State, Actions,
- Hibernate, TimeoutsR) ->
+parse_enter_actions(Debug, S, State, Actions, Hibernate, TimeoutsR) ->
Postpone = forbidden,
NextEventsR = forbidden,
parse_actions(
Debug, S, State, listify(Actions),
Hibernate, TimeoutsR, Postpone, NextEventsR).
-
+
parse_actions(Debug, S, State, Actions) ->
Hibernate = false,
- TimeoutsR = [],
+ TimeoutsR = [{timeout,infinity,infinity}], %% Will cancel event timer
Postpone = false,
NextEventsR = [],
parse_actions(
@@ -1279,64 +1341,29 @@ parse_actions(
{bad_action_from_state_function,Action},
?STACKTRACE()}
end;
+ %%
%% Actions that set options
{hibernate,NewHibernate} when is_boolean(NewHibernate) ->
parse_actions(
Debug, S, State, Actions,
NewHibernate, TimeoutsR, Postpone, NextEventsR);
- {hibernate,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
hibernate ->
+ NewHibernate = true,
parse_actions(
Debug, S, State, Actions,
- true, TimeoutsR, Postpone, NextEventsR);
- {state_timeout,Time,_} = StateTimeout
- when is_integer(Time), Time >= 0;
- Time =:= infinity ->
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, [StateTimeout|TimeoutsR], Postpone, NextEventsR);
- {state_timeout,_,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
- {timeout,infinity,_} ->
- %% Ignore - timeout will never happen and already cancelled
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, TimeoutsR, Postpone, NextEventsR);
- {timeout,Time,_} = Timeout when is_integer(Time), Time >= 0 ->
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR);
- {timeout,_,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
- infinity -> % Ignore - timeout will never happen
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, TimeoutsR, Postpone, NextEventsR);
- Time when is_integer(Time), Time >= 0 ->
- Timeout = {timeout,Time,Time},
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR);
+ NewHibernate, TimeoutsR, Postpone, NextEventsR);
+ %%
{postpone,NewPostpone}
when is_boolean(NewPostpone), Postpone =/= forbidden ->
parse_actions(
Debug, S, State, Actions,
Hibernate, TimeoutsR, NewPostpone, NextEventsR);
- {postpone,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
postpone when Postpone =/= forbidden ->
+ NewPostpone = true,
parse_actions(
Debug, S, State, Actions,
- Hibernate, TimeoutsR, true, NextEventsR);
+ Hibernate, TimeoutsR, NewPostpone, NextEventsR);
+ %%
{next_event,Type,Content} ->
case event_type(Type) of
true when NextEventsR =/= forbidden ->
@@ -1351,96 +1378,150 @@ parse_actions(
{bad_action_from_state_function,Action},
?STACKTRACE()}
end;
- _ ->
+ %%
+ {state_timeout,_,_} = Timeout ->
+ parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout);
+ {timeout,_,_} = Timeout ->
+ parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout);
+ Time ->
+ parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Time)
+ end.
+
+parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout) ->
+ Time =
+ case Timeout of
+ {_,T,_} -> T;
+ T -> T
+ end,
+ case validate_time(Time) of
+ true ->
+ parse_actions(
+ Debug, S, State, Actions,
+ Hibernate, [Timeout|TimeoutsR],
+ Postpone, NextEventsR);
+ false ->
{error,
- {bad_action_from_state_function,Action},
+ {bad_action_from_state_function,Timeout},
?STACKTRACE()}
end.
+validate_time(Time) when is_integer(Time), Time >= 0 -> true;
+validate_time(infinity) -> true;
+validate_time(_) -> false.
%% Stop and start timers as well as create timeout zero events
%% and pending event timer
%%
%% Stop and start timers non-event timers
-parse_timers(TimerRefs, TimerTypes, TimeoutsR) ->
- parse_timers(TimerRefs, TimerTypes, TimeoutsR, #{}, []).
+parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR) ->
+ parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR, #{}, []).
%%
-parse_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) ->
- {TimerRefs,TimerTypes,TimeoutEvents};
parse_timers(
- TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) ->
- {TimerType,Time,TimerMsg} = Timeout,
+ TimerRefs, TimerTypes, CancelTimers, [], _Seen, TimeoutEvents) ->
+ {TimerRefs,TimerTypes,CancelTimers,TimeoutEvents};
+parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, [Timeout|TimeoutsR],
+ Seen, TimeoutEvents) ->
+ case Timeout of
+ {TimerType,Time,TimerMsg} ->
+ parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents,
+ TimerType, Time, TimerMsg);
+ Time ->
+ parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents,
+ timeout, Time, Time)
+ end.
+
+parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents,
+ TimerType, Time, TimerMsg) ->
case Seen of
#{TimerType := _} ->
%% Type seen before - ignore
parse_timers(
- TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents);
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents);
#{} ->
%% Unseen type - handle
NewSeen = Seen#{TimerType => true},
- %% Cancel any running timer
- {NewTimerRefs,NewTimerTypes} =
- cancel_timer_by_type(TimerType, TimerRefs, TimerTypes),
- if
- Time =:= infinity ->
- %% Ignore - timer will never fire
+ case Time of
+ infinity ->
+ %% Cancel any running timer
+ {NewTimerTypes,NewCancelTimers} =
+ cancel_timer_by_type(
+ TimerType, TimerTypes, CancelTimers),
parse_timers(
- NewTimerRefs, NewTimerTypes, TimeoutsR,
+ TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR,
NewSeen, TimeoutEvents);
- TimerType =:= timeout ->
- %% Handle event timer later
- parse_timers(
- NewTimerRefs, NewTimerTypes, TimeoutsR,
- NewSeen, [Timeout|TimeoutEvents]);
- Time =:= 0 ->
+ 0 ->
+ %% Cancel any running timer
+ {NewTimerTypes,NewCancelTimers} =
+ cancel_timer_by_type(
+ TimerType, TimerTypes, CancelTimers),
%% Handle zero time timeouts later
TimeoutEvent = {TimerType,TimerMsg},
parse_timers(
- NewTimerRefs, NewTimerTypes, TimeoutsR,
+ TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR,
NewSeen, [TimeoutEvent|TimeoutEvents]);
- true ->
- %% Start a new timer
- TimerRef = erlang:start_timer(Time, self(), TimerMsg),
- parse_timers(
- NewTimerRefs#{TimerRef => TimerType},
- NewTimerTypes#{TimerType => TimerRef},
- TimeoutsR, NewSeen, TimeoutEvents)
+ _ ->
+ %% (Re)start the timer
+ TimerRef =
+ erlang:start_timer(Time, self(), TimerMsg),
+ case TimerTypes of
+ #{TimerType := OldTimerRef} ->
+ %% Cancel the running timer
+ cancel_timer(OldTimerRef),
+ NewCancelTimers = CancelTimers + 1,
+ %% Insert the new timer into
+ %% both TimerRefs and TimerTypes
+ parse_timers(
+ TimerRefs#{TimerRef => TimerType},
+ TimerTypes#{TimerType => TimerRef},
+ NewCancelTimers, TimeoutsR,
+ NewSeen, TimeoutEvents);
+ #{} ->
+ parse_timers(
+ TimerRefs#{TimerRef => TimerType},
+ TimerTypes#{TimerType => TimerRef},
+ CancelTimers, TimeoutsR,
+ NewSeen, TimeoutEvents)
+ end
end
end.
-%% Enqueue immediate timeout events and start event timer
-process_timeout_events(TimerRefs, TimerTypes, [], EventsR) ->
- {TimerRefs, TimerTypes, EventsR};
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{timeout,0,TimerMsg}|TimeoutEvents], []) ->
- %% No enqueued events - insert a timeout zero event
- TimeoutEvent = {timeout,TimerMsg},
- process_timeout_events(
- TimerRefs, TimerTypes,
- TimeoutEvents, [TimeoutEvent]);
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{timeout,Time,TimerMsg}], []) ->
- %% No enqueued events - start event timer
- TimerRef = erlang:start_timer(Time, self(), TimerMsg),
- process_timeout_events(
- TimerRefs#{TimerRef => timeout}, TimerTypes#{timeout => TimerRef},
- [], []);
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{timeout,_Time,_TimerMsg}|TimeoutEvents], EventsR) ->
- %% There will be some other event so optimize by not starting
- %% an event timer to just have to cancel it again
- process_timeout_events(
- TimerRefs, TimerTypes,
- TimeoutEvents, EventsR);
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{_TimeoutType,_TimeoutMsg} = TimeoutEvent|TimeoutEvents], EventsR) ->
- process_timeout_events(
- TimerRefs, TimerTypes,
- TimeoutEvents, [TimeoutEvent|EventsR]).
+%% Enqueue immediate timeout events (timeout 0 events)
+%%
+%% Event timer timeout 0 events gets special treatment since
+%% an event timer is cancelled by any received event,
+%% so if there are enqueued events before the event timer
+%% timeout 0 event - the event timer is cancelled hence no event.
+%%
+%% Other (state_timeout) timeout 0 events that are after
+%% the event timer timeout 0 events are considered to
+%% belong to timers that were started after the event timer
+%% timeout 0 event fired, so they do not cancel the event timer.
+%%
+prepend_timeout_events([], EventsR) ->
+ EventsR;
+prepend_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) ->
+ prepend_timeout_events(TimeoutEvents, [TimeoutEvent]);
+prepend_timeout_events([{timeout,_}|TimeoutEvents], EventsR) ->
+ prepend_timeout_events(TimeoutEvents, EventsR);
+prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) ->
+ %% Just prepend all others
+ prepend_timeout_events(TimeoutEvents, [TimeoutEvent|EventsR]).
@@ -1448,18 +1529,11 @@ process_timeout_events(
%% Server helpers
reply_then_terminate(
- Class, Reason, Stacktrace,
- Debug, #{state := State} = S, Q, Replies) ->
- if
- is_list(Replies) ->
- do_reply_then_terminate(
- Class, Reason, Stacktrace,
- Debug, S, Q, Replies, State);
- true ->
- do_reply_then_terminate(
- Class, Reason, Stacktrace,
- Debug, S, Q, [Replies], State)
- end.
+ Class, Reason, Stacktrace, Debug,
+ #{state := State} = S, Q, Replies) ->
+ do_reply_then_terminate(
+ Class, Reason, Stacktrace, Debug,
+ S, Q, listify(Replies), State).
%%
do_reply_then_terminate(
Class, Reason, Stacktrace, Debug, S, Q, [], _State) ->
@@ -1485,21 +1559,25 @@ do_reply(Debug, S, State, From, Reply) ->
terminate(
- Class, Reason, Stacktrace,
- Debug,
+ Class, Reason, Stacktrace, Debug,
#{module := Module, state := State, data := Data, postponed := P} = S,
Q) ->
- try Module:terminate(Reason, State, Data) of
- _ -> ok
- catch
- _ -> ok;
- C:R ->
- ST = erlang:get_stacktrace(),
- error_info(
- C, R, ST, S, Q, P,
- format_status(terminate, get(), S)),
- sys:print_log(Debug),
- erlang:raise(C, R, ST)
+ case erlang:function_exported(Module, terminate, 3) of
+ true ->
+ try Module:terminate(Reason, State, Data) of
+ _ -> ok
+ catch
+ _ -> ok;
+ C:R ->
+ ST = erlang:get_stacktrace(),
+ error_info(
+ C, R, ST, S, Q, P,
+ format_status(terminate, get(), S)),
+ sys:print_log(Debug),
+ erlang:raise(C, R, ST)
+ end;
+ false ->
+ ok
end,
_ =
case Reason of
@@ -1637,28 +1715,21 @@ listify(Item) ->
[Item].
%% Cancel timer if running, otherwise no op
-cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) ->
+%%
+%% This is an asynchronous cancel so the timer is not really cancelled
+%% until we get a cancel_timer msg i.e {cancel_timer,TimerRef,_}.
+%% In the mean time we might get a timeout message.
+%%
+%% Remove the timer from TimerTypes.
+%% When we get the cancel_timer msg we remove it from TimerRefs.
+cancel_timer_by_type(TimerType, TimerTypes, CancelTimers) ->
case TimerTypes of
#{TimerType := TimerRef} ->
cancel_timer(TimerRef),
- {maps:remove(TimerRef, TimerRefs),
- maps:remove(TimerType, TimerTypes)};
+ {maps:remove(TimerType, TimerTypes),CancelTimers + 1};
#{} ->
- {TimerRefs,TimerTypes}
+ {TimerTypes,CancelTimers}
end.
-%%cancel_timer(undefined) ->
-%% ok;
-cancel_timer(TRef) ->
- case erlang:cancel_timer(TRef) of
- false ->
- %% We have to assume that TRef is the ref of a running timer
- %% and if so the timer has expired
- %% hence we must wait for the timeout message
- receive
- {timeout,TRef,_} ->
- ok
- end;
- _TimeLeft ->
- ok
- end.
+cancel_timer(TimerRef) ->
+ ok = erlang:cancel_timer(TimerRef, [{async,true}]).
diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl
index f3665824f2..8c4d835432 100644
--- a/lib/stdlib/src/qlc.erl
+++ b/lib/stdlib/src/qlc.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1292,6 +1292,10 @@ abstr_term(Fun, Line) when is_function(Fun) ->
end;
abstr_term(PPR, Line) when is_pid(PPR); is_port(PPR); is_reference(PPR) ->
{special, Line, lists:flatten(io_lib:write(PPR))};
+abstr_term(Map, Line) when is_map(Map) ->
+ {map,Line,
+ [{map_field_assoc,Line,abstr_term(K, Line),abstr_term(V, Line)} ||
+ {K,V} <- maps:to_list(Map)]};
abstr_term(Simple, Line) ->
erl_parse:abstract(Simple, erl_anno:line(Line)).
diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl
index 340cc21390..fadf96146e 100644
--- a/lib/stdlib/src/zip.erl
+++ b/lib/stdlib/src/zip.erl
@@ -179,19 +179,6 @@
external_attr,
local_header_offset}).
-%% Unix extra fields (not yet supported)
--define(UNIX_EXTRA_FIELD_TAG, 16#000d).
--record(unix_extra_field, {atime,
- mtime,
- uid,
- gid}).
-
-%% extended timestamps (not yet supported)
--define(EXTENDED_TIMESTAMP_TAG, 16#5455).
-%% -record(extended_timestamp, {mtime,
-%% atime,
-%% ctime}).
-
-define(END_OF_CENTRAL_DIR_MAGIC, 16#06054b50).
-define(END_OF_CENTRAL_DIR_SZ, (4+2+2+2+2+4+4+2)).
@@ -381,9 +368,12 @@ do_unzip(F, Options) ->
{Info, In1} = get_central_dir(In0, RawIterator, Input),
%% get rid of zip-comment
Z = zlib:open(),
- Files = get_z_files(Info, Z, In1, Opts, []),
- zlib:close(Z),
- Input(close, In1),
+ Files = try
+ get_z_files(Info, Z, In1, Opts, [])
+ after
+ zlib:close(Z),
+ Input(close, In1)
+ end,
{ok, Files}.
%% Iterate over all files in a zip archive
@@ -460,11 +450,20 @@ do_zip(F, Files, Options) ->
#zip_opts{output = Output, open_opts = OpO} = Opts,
Out0 = Output({open, F, OpO}, []),
Z = zlib:open(),
- {Out1, LHS, Pos} = put_z_files(Files, Z, Out0, 0, Opts, []),
- zlib:close(Z),
- Out2 = put_central_dir(LHS, Pos, Out1, Opts),
- Out3 = Output({close, F}, Out2),
- {ok, Out3}.
+ try
+ {Out1, LHS, Pos} = put_z_files(Files, Z, Out0, 0, Opts, []),
+ zlib:close(Z),
+ Out2 = put_central_dir(LHS, Pos, Out1, Opts),
+ Out3 = Output({close, F}, Out2),
+ {ok, Out3}
+ catch
+ C:R ->
+ Stk = erlang:get_stacktrace(),
+ zlib:close(Z),
+ Output({close, F}, Out0),
+ erlang:raise(C, R, Stk)
+ end.
+
%% List zip directory contents
%%
@@ -1379,12 +1378,7 @@ cd_file_header_to_file_info(FileName,
gid = 0},
add_extra_info(FI, ExtraField).
-%% add extra info to file (some day when we implement it)
-add_extra_info(FI, <<?EXTENDED_TIMESTAMP_TAG:16/little, _Rest/binary>>) ->
- FI; % not yet supported, some other day...
-add_extra_info(FI, <<?UNIX_EXTRA_FIELD_TAG:16/little, Rest/binary>>) ->
- _UnixExtra = unix_extra_field_and_var_from_bin(Rest),
- FI; % not yet supported, and not widely used
+%% Currently, we ignore all the extra fields.
add_extra_info(FI, _) ->
FI.
@@ -1572,20 +1566,6 @@ dos_date_time_from_datetime({{Year, Month, Day}, {Hour, Min, Sec}}) ->
<<DosDate:16>> = <<YearFrom1980:7, Month:4, Day:5>>,
{DosDate, DosTime}.
-unix_extra_field_and_var_from_bin(<<TSize:16/little,
- ATime:32/little,
- MTime:32/little,
- UID:16/little,
- GID:16/little,
- Var:TSize/binary>>) ->
- {#unix_extra_field{atime = ATime,
- mtime = MTime,
- uid = UID,
- gid = GID},
- Var};
-unix_extra_field_and_var_from_bin(_) ->
- throw(bad_unix_extra_field).
-
%% A pwrite-like function for iolists (used by memory-option)
pwrite_binary(B, Pos, Bin) when byte_size(B) =:= Pos ->
diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl
index 8f2ba0cab2..ac27c9fc79 100644
--- a/lib/stdlib/test/gen_statem_SUITE.erl
+++ b/lib/stdlib/test/gen_statem_SUITE.erl
@@ -38,7 +38,7 @@ all() ->
{group, abnormal},
{group, abnormal_handle_event},
shutdown, stop_and_reply, state_enter, event_order,
- state_timeout, code_change,
+ state_timeout, event_types, code_change,
{group, sys},
hibernate, enter_loop].
@@ -600,15 +600,26 @@ state_enter(_Config) ->
(internal, Prev, N) ->
Self ! {internal,start,Prev,N},
{keep_state,N + 1};
+ ({call,From}, repeat, N) ->
+ {repeat_state,N + 1,
+ [{reply,From,{repeat,start,N}}]};
({call,From}, echo, N) ->
- {next_state,wait,N + 1,{reply,From,{echo,start,N}}};
+ {next_state,wait,N + 1,
+ {reply,From,{echo,start,N}}};
({call,From}, {stop,Reason}, N) ->
- {stop_and_reply,Reason,[{reply,From,{stop,N}}],N + 1}
+ {stop_and_reply,Reason,
+ [{reply,From,{stop,N}}],N + 1}
end,
wait =>
- fun (enter, Prev, N) ->
+ fun (enter, Prev, N) when N < 5 ->
+ {repeat_state,N + 1,
+ {reply,{Self,N},{enter,Prev}}};
+ (enter, Prev, N) ->
Self ! {enter,wait,Prev,N},
{keep_state,N + 1};
+ ({call,From}, repeat, N) ->
+ {repeat_state_and_data,
+ [{reply,From,{repeat,wait,N}}]};
({call,From}, echo, N) ->
{next_state,start,N + 1,
[{next_event,internal,wait},
@@ -620,11 +631,15 @@ state_enter(_Config) ->
[{enter,start,start,1}] = flush(),
{echo,start,2} = gen_statem:call(STM, echo),
- [{enter,wait,start,3}] = flush(),
- {wait,[4|_]} = sys:get_state(STM),
- {echo,wait,4} = gen_statem:call(STM, echo),
- [{enter,start,wait,5},{internal,start,wait,6}] = flush(),
- {stop,7} = gen_statem:call(STM, {stop,bye}),
+ [{3,{enter,start}},{4,{enter,start}},{enter,wait,start,5}] = flush(),
+ {wait,[6|_]} = sys:get_state(STM),
+ {repeat,wait,6} = gen_statem:call(STM, repeat),
+ [{enter,wait,wait,6}] = flush(),
+ {echo,wait,7} = gen_statem:call(STM, echo),
+ [{enter,start,wait,8},{internal,start,wait,9}] = flush(),
+ {repeat,start,10} = gen_statem:call(STM, repeat),
+ [{enter,start,start,11}] = flush(),
+ {stop,12} = gen_statem:call(STM, {stop,bye}),
[{'EXIT',STM,bye}] = flush(),
{noproc,_} =
@@ -801,6 +816,74 @@ state_timeout(_Config) ->
+%% Test that all event types can be sent with {next_event,EventType,_}
+event_types(_Config) ->
+ process_flag(trap_exit, true),
+
+ Machine =
+ %% Abusing the internal format of From...
+ #{init =>
+ fun () ->
+ {ok, start, undefined}
+ end,
+ start =>
+ fun ({call,_} = Call, Req, undefined) ->
+ {next_state, state1, undefined,
+ [{next_event,internal,1},
+ {next_event,state_timeout,2},
+ {next_event,timeout,3},
+ {next_event,info,4},
+ {next_event,cast,5},
+ {next_event,Call,Req}]}
+ end,
+ state1 =>
+ fun (internal, 1, undefined) ->
+ {next_state, state2, undefined}
+ end,
+ state2 =>
+ fun (state_timeout, 2, undefined) ->
+ {next_state, state3, undefined}
+ end,
+ state3 =>
+ fun (timeout, 3, undefined) ->
+ {next_state, state4, undefined}
+ end,
+ state4 =>
+ fun (info, 4, undefined) ->
+ {next_state, state5, undefined}
+ end,
+ state5 =>
+ fun (cast, 5, undefined) ->
+ {next_state, state6, undefined}
+ end,
+ state6 =>
+ fun ({call,From}, stop, undefined) ->
+ {stop_and_reply, shutdown,
+ [{reply,From,stopped}]}
+ end},
+ {ok,STM} =
+ gen_statem:start_link(
+ ?MODULE, {map_statem,Machine,[]}, [{debug,[trace]}]),
+
+ stopped = gen_statem:call(STM, stop),
+ receive
+ {'EXIT',STM,shutdown} ->
+ ok
+ after 500 ->
+ ct:fail(did_not_stop)
+ end,
+
+ {noproc,_} =
+ ?EXPECT_FAILURE(gen_statem:call(STM, hej), Reason),
+ case flush() of
+ [] ->
+ ok;
+ Other2 ->
+ ct:fail({unexpected,Other2})
+ end.
+
+
+
sys1(Config) ->
{ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []),
{status, Pid, {module,gen_statem}, _} = sys:get_status(Pid),
@@ -1722,6 +1805,10 @@ handle_event(
{keep_state,[NewData|Machine]};
{keep_state,NewData,Ops} ->
{keep_state,[NewData|Machine],Ops};
+ {repeat_state,NewData} ->
+ {repeat_state,[NewData|Machine]};
+ {repeat_state,NewData,Ops} ->
+ {repeat_state,[NewData|Machine],Ops};
Other ->
Other
end;
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index c08e138ad3..2b5d52287e 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -886,11 +886,12 @@ eval_unique(Config) when is_list(Config) ->
[a] = qlc:e(Q2, {unique_all, true})
">>,
- <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1]],unique)],
+ <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1,#{a => 1}]],
+ unique)],
unique),
{call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} =
qlc:info(Q, [{format,abstract_code},unique_all]),
- [1,2] = qlc:e(Q)">>,
+ [1,2,#{a := 1}] = qlc:e(Q)">>,
<<"Q = qlc:q([X || X <- [1,2,1]]),
{call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} =
@@ -2637,7 +2638,16 @@ info(Config) when is_list(Config) ->
{cons, _, _, _}]},
{nil,_}}]}]} = i(QH, {format, abstract_code}),
[{5},{6}] = qlc:e(QH),
- [{4},{5},{6}] = qlc:e(F(3))">>
+ [{4},{5},{6}] = qlc:e(F(3))">>,
+
+ <<"Fun = fun ?MODULE:i/2,
+ L = [{#{k => #{v => Fun}}, Fun}],
+ H = qlc:q([Q || Q <- L, Q =:= {#{k => #{v => Fun}}, Fun}]),
+ L = qlc:e(H),
+ {call,_,_,[{lc,_,{var,_,'Q'},
+ [{generate,_,_,_},
+ {op,_,_,_,_}]}]} =
+ qlc:info(H, [{format,abstract_code}])">>
],
run(Config, Ts),
diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl
index 7d90795c9e..f0feda217a 100644
--- a/lib/stdlib/test/zip_SUITE.erl
+++ b/lib/stdlib/test/zip_SUITE.erl
@@ -27,7 +27,7 @@
openzip_api/1, zip_api/1, open_leak/1, unzip_jar/1,
unzip_traversal_exploit/1,
compress_control/1,
- foldl/1]).
+ foldl/1,fd_leak/1]).
-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
@@ -40,7 +40,7 @@ all() ->
unzip_to_binary, zip_to_binary, unzip_options,
zip_options, list_dir_options, aliases, openzip_api,
zip_api, open_leak, unzip_jar, compress_control, foldl,
- unzip_traversal_exploit].
+ unzip_traversal_exploit,fd_leak].
groups() ->
[].
@@ -882,3 +882,35 @@ foldl(Config) ->
{error, enoent} = zip:foldl(ZipFun, [], File),
ok.
+
+fd_leak(Config) ->
+ ok = file:set_cwd(proplists:get_value(priv_dir, Config)),
+ DataDir = proplists:get_value(data_dir, Config),
+ Name = filename:join(DataDir, "bad_file_header.zip"),
+ BadExtract = fun() ->
+ {error,bad_file_header} = zip:extract(Name),
+ ok
+ end,
+ do_fd_leak(BadExtract, 1),
+
+ BadCreate = fun() ->
+ {error,enoent} = zip:zip("failed.zip",
+ ["none"]),
+ ok
+ end,
+ do_fd_leak(BadCreate, 1),
+
+ ok.
+
+do_fd_leak(_Bad, 10000) ->
+ ok;
+do_fd_leak(Bad, N) ->
+ try Bad() of
+ ok ->
+ do_fd_leak(Bad, N + 1)
+ catch
+ C:R ->
+ Stk = erlang:get_stacktrace(),
+ io:format("Bad error after ~p attempts\n", [N]),
+ erlang:raise(C, R, Stk)
+ end.
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-05 13:31:49 +0000