diff options
Diffstat (limited to 'lib/stdlib/src')
| -rw-r--r-- | lib/stdlib/src/beam_lib.erl | 2 | ||||
| -rw-r--r-- | lib/stdlib/src/edlin_expand.erl | 95 | ||||
| -rw-r--r-- | lib/stdlib/src/erl_eval.erl | 1 | ||||
| -rw-r--r-- | lib/stdlib/src/erl_parse.yrl | 42 | ||||
| -rw-r--r-- | lib/stdlib/src/escript.erl | 85 | ||||
| -rw-r--r-- | lib/stdlib/src/ets.erl | 8 | ||||
| -rw-r--r-- | lib/stdlib/src/gen_statem.erl | 1340 | ||||
| -rw-r--r-- | lib/stdlib/src/ms_transform.erl | 2 | ||||
| -rw-r--r-- | lib/stdlib/src/shell.erl | 4 | ||||
| -rw-r--r-- | lib/stdlib/src/stdlib.appup.src | 4 | ||||
| -rw-r--r-- | lib/stdlib/src/supervisor.erl | 4 | ||||
| -rw-r--r-- | lib/stdlib/src/zip.erl | 82 |
12 files changed, 1056 insertions, 613 deletions
diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl index fe9df601eb..d7ee5c1f5d 100644 --- a/lib/stdlib/src/beam_lib.erl +++ b/lib/stdlib/src/beam_lib.erl @@ -55,7 +55,7 @@ -type beam() :: module() | file:filename() | binary(). --type forms() :: [erl_parse:abstract_form()]. +-type forms() :: [erl_parse:abstract_form() | erl_parse:form_info()]. -type abst_code() :: {AbstVersion :: atom(), forms()} | 'no_abstract_code'. -type dataB() :: binary(). diff --git a/lib/stdlib/src/edlin_expand.erl b/lib/stdlib/src/edlin_expand.erl index ec64470461..a1a97af4c5 100644 --- a/lib/stdlib/src/edlin_expand.erl +++ b/lib/stdlib/src/edlin_expand.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2016. All Rights Reserved. +%% Copyright Ericsson AB 2005-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. @@ -101,44 +101,77 @@ match(Prefix, Alts, Extra0) -> %% Return the list of names L in multiple columns. format_matches(L) -> - S = format_col(lists:sort(L), []), + {S1, Dots} = format_col(lists:sort(L), []), + S = case Dots of + true -> + {_, Prefix} = longest_common_head(vals(L)), + PrefixLen = length(Prefix), + case PrefixLen =< 3 of + true -> S1; % Do not replace the prefix with "...". + false -> + LeadingDotsL = leading_dots(L, PrefixLen), + {S2, _} = format_col(lists:sort(LeadingDotsL), []), + S2 + end; + false -> S1 + end, ["\n" | S]. format_col([], _) -> []; -format_col(L, Acc) -> format_col(L, field_width(L), 0, Acc). - -format_col(X, Width, Len, Acc) when Width + Len > 79 -> - format_col(X, Width, 0, ["\n" | Acc]); -format_col([A|T], Width, Len, Acc0) -> - H = case A of - %% If it's a tuple {string(), integer()}, we assume it's an - %% arity, and meant to be printed. - {H0, I} when is_integer(I) -> - H0 ++ "/" ++ integer_to_list(I); - {H1, _} -> H1; - H2 -> H2 - end, - Acc = [io_lib:format("~-*s", [Width,H]) | Acc0], - format_col(T, Width, Len+Width, Acc); -format_col([], _, _, Acc) -> - lists:reverse(Acc, "\n"). - -field_width(L) -> field_width(L, 0). - -field_width([{H,_}|T], W) -> +format_col(L, Acc) -> + LL = 79, + format_col(L, field_width(L, LL), 0, Acc, LL, false). + +format_col(X, Width, Len, Acc, LL, Dots) when Width + Len > LL -> + format_col(X, Width, 0, ["\n" | Acc], LL, Dots); +format_col([A|T], Width, Len, Acc0, LL, Dots) -> + {H0, R} = format_val(A), + Hmax = LL - length(R), + {H, NewDots} = + case length(H0) > Hmax of + true -> {io_lib:format("~-*ts", [Hmax - 3, H0]) ++ "...", true}; + false -> {H0, Dots} + end, + Acc = [io_lib:format("~-*ts", [Width, H ++ R]) | Acc0], + format_col(T, Width, Len+Width, Acc, LL, NewDots); +format_col([], _, _, Acc, _LL, Dots) -> + {lists:reverse(Acc, "\n"), Dots}. + +format_val({H, I}) when is_integer(I) -> + %% If it's a tuple {string(), integer()}, we assume it's an + %% arity, and meant to be printed. + {H, "/" ++ integer_to_list(I)}; +format_val({H, _}) -> + {H, ""}; +format_val(H) -> + {H, ""}. + +field_width(L, LL) -> field_width(L, 0, LL). + +field_width([{H,_}|T], W, LL) -> case length(H) of - L when L > W -> field_width(T, L); - _ -> field_width(T, W) + L when L > W -> field_width(T, L, LL); + _ -> field_width(T, W, LL) end; -field_width([H|T], W) -> +field_width([H|T], W, LL) -> case length(H) of - L when L > W -> field_width(T, L); - _ -> field_width(T, W) + L when L > W -> field_width(T, L, LL); + _ -> field_width(T, W, LL) end; -field_width([], W) when W < 40 -> +field_width([], W, LL) when W < LL - 3 -> W + 4; -field_width([], _) -> - 40. +field_width([], _, LL) -> + LL. + +vals([]) -> []; +vals([{S, _}|L]) -> [S|vals(L)]; +vals([S|L]) -> [S|vals(L)]. + +leading_dots([], _Len) -> []; +leading_dots([{H, I}|L], Len) -> + [{"..." ++ nthtail(Len, H), I}|leading_dots(L, Len)]; +leading_dots([H|L], Len) -> + ["..." ++ nthtail(Len, H)|leading_dots(L, Len)]. longest_common_head([]) -> no; diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl index 40a34aa30f..eafee346eb 100644 --- a/lib/stdlib/src/erl_eval.erl +++ b/lib/stdlib/src/erl_eval.erl @@ -1306,6 +1306,7 @@ partial_eval(Expr) -> ev_expr({op,_,Op,L,R}) -> erlang:Op(ev_expr(L), ev_expr(R)); ev_expr({op,_,Op,A}) -> erlang:Op(ev_expr(A)); ev_expr({integer,_,X}) -> X; +ev_expr({char,_,X}) -> X; ev_expr({float,_,X}) -> X; ev_expr({atom,_,X}) -> X; ev_expr({tuple,_,Es}) -> diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl index 85b2816451..d2dd2848b5 100644 --- a/lib/stdlib/src/erl_parse.yrl +++ b/lib/stdlib/src/erl_parse.yrl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-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. @@ -156,6 +156,7 @@ type -> '#' atom '{' field_types '}' : {type, ?anno('$1'), record, ['$2'|'$4']}. type -> binary_type : '$1'. type -> integer : '$1'. +type -> char : '$1'. type -> 'fun' '(' ')' : {type, ?anno('$1'), 'fun', []}. type -> 'fun' '(' fun_type_100 ')' : '$3'. @@ -612,11 +613,11 @@ Erlang code. | af_bin(abstract_expr()) | af_binary_op(abstract_expr()) | af_unary_op(abstract_expr()) - | af_record_access(abstract_expr()) + | af_record_creation(abstract_expr()) | af_record_update(abstract_expr()) | af_record_index() | af_record_field_access(abstract_expr()) - | af_map_access(abstract_expr()) + | af_map_creation(abstract_expr()) | af_map_update(abstract_expr()) | af_catch() | af_local_call() @@ -720,26 +721,25 @@ Erlang code. | af_bin(af_guard_test()) | af_binary_op(af_guard_test()) | af_unary_op(af_guard_test()) - | af_record_access(af_guard_test()) + | af_record_creation(af_guard_test()) | af_record_index() | af_record_field_access(af_guard_test()) - | af_map_access(abstract_expr()) % FIXME - | af_map_update(abstract_expr()) % FIXME + | af_map_creation(abstract_expr()) + | af_map_update(abstract_expr()) | af_guard_call() | af_remote_guard_call(). -type af_record_field_access(T) :: {'record_field', anno(), T, record_name(), af_field_name()}. --type af_map_access(T) :: {'map', anno(), [af_map_field(T)]}. - --type af_map_update(T) :: {'map', anno(), T, [af_map_field(T)]}. +-type af_map_creation(T) :: {'map', anno(), [af_assoc(T)]}. --type af_map_field(T) :: af_map_field_assoc(T) | af_map_field_exact(T). +-type af_map_update(T) :: {'map', anno(), T, [af_assoc(T)]}. --type af_map_field_assoc(T) :: {'map_field_assoc', anno(), T, T}. +-type af_assoc(T) :: {'map_field_assoc', anno(), T, T} + | af_assoc_exact(T). --type af_map_field_exact(T) :: {'map_field_exact', anno(), T, T}. +-type af_assoc_exact(T) :: {'map_field_exact', anno(), T, T}. -type af_guard_call() :: {'call', anno(), function_name(), [af_guard_test()]}. @@ -757,20 +757,20 @@ Erlang code. | af_bin(af_pattern()) | af_binary_op(af_pattern()) | af_unary_op(af_pattern()) - | af_record_access(af_pattern()) + | af_record_creation(af_pattern()) | af_record_index() | af_map_pattern(). -type af_record_index() :: {'record_index', anno(), record_name(), af_field_name()}. --type af_record_access(T) :: +-type af_record_creation(T) :: {'record', anno(), record_name(), [af_record_field(T)]}. -type af_record_field(T) :: {'record_field', anno(), af_field_name(), T}. -type af_map_pattern() :: - {'map', anno(), [af_map_field_exact(abstract_expr)]}. % FIXME? + {'map', anno(), [af_assoc_exact(abstract_expr)]}. -type abstract_type() :: af_annotated_type() | af_atom() @@ -807,9 +807,9 @@ Erlang code. {'type', anno(), 'range', [af_singleton_integer_type()]}. -type af_map_type() :: {'type', anno(), 'map', 'any'} - | {'type', anno(), 'map', [af_map_pair_type()]}. + | {'type', anno(), 'map', [af_assoc_type()]}. --type af_map_pair_type() :: +-type af_assoc_type() :: {'type', anno(), 'map_field_assoc', [abstract_type()]} | {'type', anno(), 'map_field_exact', [abstract_type()]}. @@ -1558,13 +1558,17 @@ new_anno(Term) -> Abstr :: erl_parse_tree(). anno_to_term(Abstract) -> - map_anno(fun erl_anno:to_term/1, Abstract). + F = fun(Anno, Acc) -> {erl_anno:to_term(Anno), Acc} end, + {NewAbstract, []} = modify_anno1(Abstract, [], F), + NewAbstract. -spec anno_from_term(Term) -> erl_parse_tree() when Term :: term(). anno_from_term(Term) -> - map_anno(fun erl_anno:from_term/1, Term). + F = fun(T, Acc) -> {erl_anno:from_term(T), Acc} end, + {NewTerm, []} = modify_anno1(Term, [], F), + NewTerm. %% Forms. %% Recognize what sys_pre_expand does: diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl index f53b0e2246..c42ae981e7 100644 --- a/lib/stdlib/src/escript.erl +++ b/lib/stdlib/src/escript.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2015. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -481,46 +481,49 @@ find_first_body_line(Fd, HeaderSz0, LineNo, KeepFirst, Sections) -> %% Look for special comment on second line Line2 = get_line(Fd), {ok, HeaderSz2} = file:position(Fd, cur), - case classify_line(Line2) of - emu_args -> - %% Skip special comment on second line - Line3 = get_line(Fd), - {HeaderSz2, LineNo + 2, Fd, - Sections#sections{type = guess_type(Line3), - comment = undefined, - emu_args = Line2}}; - Line2Type -> - %% Look for special comment on third line - Line3 = get_line(Fd), - {ok, HeaderSz3} = file:position(Fd, cur), - Line3Type = classify_line(Line3), - if - Line3Type =:= emu_args -> - %% Skip special comment on third line - Line4 = get_line(Fd), - {HeaderSz3, LineNo + 3, Fd, - Sections#sections{type = guess_type(Line4), - comment = Line2, - emu_args = Line3}}; - Sections#sections.shebang =:= undefined, - KeepFirst =:= true -> - %% No shebang. Use the entire file - {HeaderSz0, LineNo, Fd, - Sections#sections{type = guess_type(Line2)}}; - Sections#sections.shebang =:= undefined -> - %% No shebang. Skip the first line - {HeaderSz1, LineNo, Fd, - Sections#sections{type = guess_type(Line2)}}; - Line2Type =:= comment -> - %% Skip shebang on first line and comment on second - {HeaderSz2, LineNo + 2, Fd, - Sections#sections{type = guess_type(Line3), - comment = Line2}}; - true -> - %% Just skip shebang on first line - {HeaderSz1, LineNo + 1, Fd, - Sections#sections{type = guess_type(Line2)}} - end + if + Sections#sections.shebang =:= undefined, + KeepFirst =:= true -> + %% No shebang. Use the entire file + {HeaderSz0, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + Sections#sections.shebang =:= undefined -> + %% No shebang. Skip the first line + {HeaderSz1, LineNo, Fd, + Sections#sections{type = guess_type(Line2)}}; + true -> + case classify_line(Line2) of + emu_args -> + %% Skip special comment on second line + Line3 = get_line(Fd), + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = undefined, + emu_args = Line2}}; + comment -> + %% Look for special comment on third line + Line3 = get_line(Fd), + {ok, HeaderSz3} = file:position(Fd, cur), + Line3Type = classify_line(Line3), + if + Line3Type =:= emu_args -> + %% Skip special comment on third line + Line4 = get_line(Fd), + {HeaderSz3, LineNo + 3, Fd, + Sections#sections{type = guess_type(Line4), + comment = Line2, + emu_args = Line3}}; + true -> + %% Skip shebang on first line and comment on second + {HeaderSz2, LineNo + 2, Fd, + Sections#sections{type = guess_type(Line3), + comment = Line2}} + end; + _ -> + %% Just skip shebang on first line + {HeaderSz1, LineNo + 1, Fd, + Sections#sections{type = guess_type(Line2)}} + end end. classify_line(Line) -> diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl index 3f74e01692..20de06fd0b 100644 --- a/lib/stdlib/src/ets.erl +++ b/lib/stdlib/src/ets.erl @@ -232,20 +232,20 @@ match(_) -> match_object(_, _) -> erlang:nif_error(undef). --spec match_object(Tab, Pattern, Limit) -> {[Match], Continuation} | +-spec match_object(Tab, Pattern, Limit) -> {[Object], Continuation} | '$end_of_table' when Tab :: tab(), Pattern :: match_pattern(), Limit :: pos_integer(), - Match :: [term()], + Object :: tuple(), Continuation :: continuation(). match_object(_, _, _) -> erlang:nif_error(undef). --spec match_object(Continuation) -> {[Match], Continuation} | +-spec match_object(Continuation) -> {[Object], Continuation} | '$end_of_table' when - Match :: [term()], + Object :: tuple(), Continuation :: continuation(). match_object(_) -> diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl index 23bddafeed..018aca90e6 100644 --- a/lib/stdlib/src/gen_statem.erl +++ b/lib/stdlib/src/gen_statem.erl @@ -24,7 +24,7 @@ [start/3,start/4,start_link/3,start_link/4, stop/1,stop/3, cast/2,call/2,call/3, - enter_loop/5,enter_loop/6,enter_loop/7, + enter_loop/4,enter_loop/5,enter_loop/6, reply/1,reply/2]). %% gen callbacks @@ -44,15 +44,20 @@ -export( [wakeup_from_hibernate/3]). -%% Type exports for templates +%% Type exports for templates and callback modules -export_type( [event_type/0, - callback_mode/0, + init_result/0, + callback_mode_result/0, state_function_result/0, handle_event_result/0, + state_enter_result/1, + event_handler_result/1, + reply_action/0, + enter_action/0, action/0]). -%% Fix problem for doc build +%% Type that is exported just to be documented -export_type([transition_option/0]). %%%========================================================================== @@ -63,8 +68,8 @@ {To :: pid(), Tag :: term()}. % Reply-to specifier for call -type state() :: - state_name() | % For state callback function StateName/5 - term(). % For state callback function handle_event/5 + state_name() | % For StateName/3 callback functions + term(). % For handle_event/4 callback function -type state_name() :: atom(). @@ -72,12 +77,16 @@ -type event_type() :: {'call',From :: from()} | 'cast' | - 'info' | 'timeout' | 'internal'. + 'info' | 'timeout' | 'state_timeout' | 'internal'. +-type callback_mode_result() :: + callback_mode() | [callback_mode() | state_enter()]. -type callback_mode() :: 'state_functions' | 'handle_event_function'. +-type state_enter() :: 'state_enter'. -type transition_option() :: - postpone() | hibernate() | event_timeout(). + postpone() | hibernate() | + event_timeout() | state_timeout(). -type postpone() :: %% If 'true' postpone the current event %% and retry it when the state changes (=/=) @@ -89,6 +98,10 @@ %% Generate a ('timeout', EventContent, ...) event after Time %% unless some other event is delivered Time :: timeout(). +-type state_timeout() :: + %% Generate a ('state_timeout', EventContent, ...) event after Time + %% unless the state is changed + Time :: timeout(). -type action() :: %% During a state change: @@ -96,7 +109,7 @@ %% * All action()s are executed in order of apperance. %% * Postponing the current event is performed %% iff 'postpone' is 'true'. - %% * A state timer is started iff 'timeout' is set. + %% * A state timeout is started iff 'timeout' is set. %% * Pending events are handled or if there are %% no pending events the server goes into receive %% or hibernate (iff 'hibernate' is 'true') @@ -108,44 +121,67 @@ 'postpone' | % Set the postpone option {'postpone', Postpone :: postpone()} | %% + %% All 'next_event' events are kept in a list and then + %% inserted at state changes so the first in the + %% action() list is the first to be delivered. + {'next_event', % Insert event as the next to handle + EventType :: event_type(), + EventContent :: term()} | + enter_action(). +-type enter_action() :: 'hibernate' | % Set the hibernate option {'hibernate', Hibernate :: hibernate()} | %% (Timeout :: event_timeout()) | % {timeout,Timeout} - {'timeout', % Set the event timeout option + {'timeout', % Set the event_timeout option Time :: event_timeout(), EventContent :: term()} | + {'state_timeout', % Set the state_timeout option + Time :: state_timeout(), EventContent :: term()} | %% - reply_action() | - %% - %% All 'next_event' events are kept in a list and then - %% inserted at state changes so the first in the - %% action() list is the first to be delivered. - {'next_event', % Insert event as the next to handle - EventType :: event_type(), - EventContent :: term()}. + reply_action(). -type reply_action() :: {'reply', % Reply to a caller From :: from(), Reply :: term()}. +-type init_result() :: + {ok, state(), data()} | + {ok, state(), data(), [action()] | action()} | + 'ignore' | + {'stop', Reason :: term()}. + +%% Old, not advertised -type state_function_result() :: - {'next_state', % {next_state,NextStateName,NewData,[]} - NextStateName :: state_name(), + event_handler_result(state_name()). +-type handle_event_result() :: + event_handler_result(state()). +%% +-type state_enter_result(State) :: + {'next_state', % {next_state,NextState,NewData,[]} + State, NewData :: data()} | {'next_state', % State transition, maybe to the same state - NextStateName :: state_name(), + State, NewData :: data(), - Actions :: [action()] | action()} | - common_state_callback_result(). --type handle_event_result() :: + Actions :: [enter_action()] | enter_action()} | + state_callback_result(enter_action()). +-type event_handler_result(StateType) :: {'next_state', % {next_state,NextState,NewData,[]} - NextState :: state(), + NextState :: StateType, NewData :: data()} | {'next_state', % State transition, maybe to the same state - NextState :: state(), + NextState :: StateType, NewData :: data(), Actions :: [action()] | action()} | - common_state_callback_result(). --type common_state_callback_result() :: + state_callback_result(action()). +-type state_callback_result(ActionType) :: + {'keep_state', % {keep_state,NewData,[]} + NewData :: data()} | + {'keep_state', % Keep state, change data + NewData :: data(), + Actions :: [ActionType] | ActionType} | + 'keep_state_and_data' | % {keep_state_and_data,[]} + {'keep_state_and_data', % Keep state and data -> only actions + Actions :: [ActionType] | ActionType} | 'stop' | % {stop,normal} {'stop', % Stop the server Reason :: term()} | @@ -158,50 +194,52 @@ {'stop_and_reply', % Reply then stop the server Reason :: term(), Replies :: [reply_action()] | reply_action(), - NewData :: data()} | - {'keep_state', % {keep_state,NewData,[]} - NewData :: data()} | - {'keep_state', % Keep state, change data - NewData :: data(), - Actions :: [action()] | action()} | - 'keep_state_and_data' | % {keep_state_and_data,[]} - {'keep_state_and_data', % Keep state and data -> only actions - Actions :: [action()] | action()}. + NewData :: data()}. %% The state machine init function. It is called only once and %% 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()) -> - {callback_mode(), state(), data()} | - {callback_mode(), state(), data(), [action()] | action()} | - 'ignore' | - {'stop', Reason :: term()}. +-callback init(Args :: term()) -> init_result(). -%% Example state callback for callback_mode() =:= state_functions -%% state name 'state_name'. +%% This callback shall return the callback mode of the callback module. %% -%% In this mode all states has to be type state_name() i.e atom(). +%% It is called once after init/0 and code_change/4 but before +%% the first state callback StateName/3 or handle_event/4. +-callback callback_mode() -> callback_mode_result(). + +%% Example state callback for StateName = 'state_name' +%% when callback_mode() =:= state_functions. %% -%% Note that state callbacks and only state callbacks have arity 5 -%% and that is intended. +%% In this mode all states has to be of type state_name() i.e atom(). +%% +%% Note that the only callbacks that have arity 3 are these +%% StateName/3 callbacks and terminate/3, so the state name +%% 'terminate' is unusable in this mode. -callback state_name( - event_type(), + 'enter', + OldStateName :: state_name(), + Data :: data()) -> + state_enter_result('state_name'); + (event_type(), EventContent :: term(), Data :: data()) -> - state_function_result(). + event_handler_result(state_name()). %% -%% State callback for callback_mode() =:= handle_event_function. -%% -%% Note that state callbacks and only state callbacks have arity 5 -%% and that is intended. +%% State callback for all states +%% when callback_mode() =:= handle_event_function. -callback handle_event( - event_type(), + 'enter', + OldState :: state(), + State, % Current state + Data :: data()) -> + state_enter_result(State); + (event_type(), EventContent :: term(), State :: state(), % Current state Data :: data()) -> - handle_event_result(). + event_handler_result(state()). %% Clean up before the server terminates. -callback terminate( @@ -219,9 +257,8 @@ OldState :: state(), OldData :: data(), Extra :: term()) -> - {NewCallbackMode :: callback_mode(), - NewState :: state(), - NewData :: data()}. + {ok, NewState :: state(), NewData :: data()} | + (Reason :: term()). %% Format the callback module state in some sensible that is %% often condensed way. For StatusOption =:= 'normal' the perferred @@ -239,10 +276,13 @@ [init/1, % One may use enter_loop/5,6,7 instead format_status/2, % Has got a default implementation %% - state_name/3, % Example for callback_mode =:= state_functions: - %% there has to be a StateName/5 callback function for every StateName. + state_name/3, % Example for callback_mode() =:= state_functions: + %% there has to be a StateName/3 callback function + %% for every StateName in your state machine but the state name + %% 'state_name' does of course not have to be used. %% - handle_event/4]). % For callback_mode =:= handle_event_function + handle_event/4 % For callback_mode() =:= handle_event_function + ]). %% Type validation functions callback_mode(CallbackMode) -> @@ -378,53 +418,79 @@ call(ServerRef, Request) -> -spec call( ServerRef :: server_ref(), Request :: term(), - Timeout :: timeout()) -> + Timeout :: + timeout() | + {'clean_timeout',T :: timeout()} | + {'dirty_timeout',T :: timeout()}) -> Reply :: term(). -call(ServerRef, Request, infinity) -> - try gen:call(ServerRef, '$gen_call', Request, infinity) of - {ok,Reply} -> - Reply - catch - Class:Reason -> - erlang:raise( - Class, - {Reason,{?MODULE,call,[ServerRef,Request,infinity]}}, - erlang:get_stacktrace()) - end; call(ServerRef, Request, Timeout) -> - %% Call server through proxy process to dodge any late reply - Ref = make_ref(), - Self = self(), - Pid = spawn( - fun () -> - Self ! - try gen:call( - ServerRef, '$gen_call', Request, Timeout) of - Result -> - {Ref,Result} - catch Class:Reason -> - {Ref,Class,Reason,erlang:get_stacktrace()} - end - end), - Mref = monitor(process, Pid), - receive - {Ref,Result} -> - demonitor(Mref, [flush]), - case Result of + case parse_timeout(Timeout) of + {dirty_timeout,T} -> + try gen:call(ServerRef, '$gen_call', Request, T) of {ok,Reply} -> Reply + catch + Class:Reason -> + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + erlang:get_stacktrace()) + end; + {clean_timeout,T} -> + %% Call server through proxy process to dodge any late reply + Ref = make_ref(), + Self = self(), + Pid = spawn( + fun () -> + Self ! + try gen:call( + ServerRef, '$gen_call', Request, T) of + Result -> + {Ref,Result} + catch Class:Reason -> + {Ref,Class,Reason, + erlang:get_stacktrace()} + end + end), + Mref = monitor(process, Pid), + receive + {Ref,Result} -> + demonitor(Mref, [flush]), + case Result of + {ok,Reply} -> + Reply + end; + {Ref,Class,Reason,Stacktrace} -> + demonitor(Mref, [flush]), + erlang:raise( + Class, + {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, + Stacktrace); + {'DOWN',Mref,_,_,Reason} -> + %% There is a theoretical possibility that the + %% proxy process gets killed between try--of and ! + %% so this clause is in case of that + exit(Reason) end; - {Ref,Class,Reason,Stacktrace} -> - demonitor(Mref, [flush]), - erlang:raise( - Class, - {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}}, - Stacktrace); - {'DOWN',Mref,_,_,Reason} -> - %% There is a theoretical possibility that the - %% proxy process gets killed between try--of and ! - %% so this clause is in case of that - exit(Reason) + Error when is_atom(Error) -> + erlang:error(Error, [ServerRef,Request,Timeout]) + end. + +parse_timeout(Timeout) -> + case Timeout of + {clean_timeout,infinity} -> + {dirty_timeout,infinity}; + {clean_timeout,_} -> + Timeout; + {dirty_timeout,_} -> + Timeout; + {_,_} -> + %% Be nice and throw a badarg for speling errors + badarg; + infinity -> + {dirty_timeout,infinity}; + T -> + {clean_timeout,T} end. %% Reply from a state machine callback to whom awaits in call/2 @@ -450,43 +516,35 @@ reply({To,Tag}, Reply) when is_pid(To) -> %% the same arguments as you would have returned from init/1 -spec enter_loop( Module :: module(), Opts :: [debug_opt()], - CallbackMode :: callback_mode(), State :: state(), Data :: data()) -> no_return(). -enter_loop(Module, Opts, CallbackMode, State, Data) -> - enter_loop(Module, Opts, CallbackMode, State, Data, self()). +enter_loop(Module, Opts, State, Data) -> + enter_loop(Module, Opts, State, Data, self()). %% -spec enter_loop( Module :: module(), Opts :: [debug_opt()], - CallbackMode :: callback_mode(), State :: state(), Data :: data(), Server_or_Actions :: server_name() | pid() | [action()]) -> no_return(). -enter_loop(Module, Opts, CallbackMode, State, Data, Server_or_Actions) -> +enter_loop(Module, Opts, State, Data, Server_or_Actions) -> if is_list(Server_or_Actions) -> - enter_loop( - Module, Opts, CallbackMode, State, Data, - self(), Server_or_Actions); + enter_loop(Module, Opts, State, Data, self(), Server_or_Actions); true -> - enter_loop( - Module, Opts, CallbackMode, State, Data, - Server_or_Actions, []) + enter_loop(Module, Opts, State, Data, Server_or_Actions, []) end. %% -spec enter_loop( Module :: module(), Opts :: [debug_opt()], - CallbackMode :: callback_mode(), State :: state(), Data :: data(), Server :: server_name() | pid(), Actions :: [action()] | action()) -> no_return(). -enter_loop(Module, Opts, CallbackMode, State, Data, Server, Actions) -> +enter_loop(Module, Opts, State, Data, Server, Actions) -> is_atom(Module) orelse error({atom,Module}), - callback_mode(CallbackMode) orelse error({callback_mode,CallbackMode}), Parent = gen:get_parent(), - enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent). + enter(Module, Opts, State, Data, Server, Actions, Parent). %%--------------------------------------------------------------------------- %% API helpers @@ -514,12 +572,13 @@ send(Proc, Msg) -> end. %% Here the init_it/6 and enter_loop/5,6,7 functions converge -enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) -> +enter(Module, Opts, State, Data, Server, Actions, Parent) -> %% The values should already have been type checked Name = gen:get_proc_name(Server), Debug = gen:debug_options(Name, Opts), - P = Events = [], - Event = {internal,initial_state}, + Events = [], + P = [], + Event = {internal,init_state}, %% We enforce {postpone,false} to ensure that %% our fake Event gets discarded, thought it might get logged NewActions = @@ -530,20 +589,33 @@ enter(Module, Opts, CallbackMode, State, Data, Server, Actions, Parent) -> [Actions,{postpone,false}] end, S = #{ - callback_mode => CallbackMode, + callback_mode => undefined, + state_enter => false, module => Module, name => Name, - %% All fields below will be replaced according to the arguments to - %% loop_event_actions/10 when it finally loops back to loop/3 state => State, data => Data, postponed => P, - hibernate => false, - timer => undefined}, + %% 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 + }, NewDebug = sys_debug(Debug, S, State, {enter,Event,State}), - loop_event_actions( - Parent, NewDebug, S, Events, - State, Data, P, Event, State, NewActions). + case call_callback_mode(S) of + {ok,NewS} -> + TimerRefs = #{}, + TimerTypes = #{}, + loop_event_actions( + Parent, NewDebug, NewS, TimerRefs, TimerTypes, + Events, Event, State, Data, NewActions); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + NewDebug, S, [Event|Events]) + end. %%%========================================================================== %%% gen callbacks @@ -558,9 +630,17 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> Result -> init_result(Starter, Parent, ServerRef, Module, Result, Opts); Class:Reason -> + Stacktrace = erlang:get_stacktrace(), + Name = gen:get_proc_name(ServerRef), gen:unregister_name(ServerRef), proc_lib:init_ack(Starter, {error,Reason}), - erlang:raise(Class, Reason, erlang:get_stacktrace()) + error_info( + Class, Reason, Stacktrace, + #{name => Name, + callback_mode => undefined, + state_enter => false}, + [], [], undefined), + erlang:raise(Class, Reason, Stacktrace) end. %%--------------------------------------------------------------------------- @@ -568,30 +648,12 @@ init_it(Starter, Parent, ServerRef, Module, Args, Opts) -> init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> case Result of - {CallbackMode,State,Data} -> - case callback_mode(CallbackMode) of - true -> - proc_lib:init_ack(Starter, {ok,self()}), - enter( - Module, Opts, CallbackMode, State, Data, - ServerRef, [], Parent); - false -> - Error = {callback_mode,CallbackMode}, - proc_lib:init_ack(Starter, {error,Error}), - exit(Error) - end; - {CallbackMode,State,Data,Actions} -> - case callback_mode(CallbackMode) of - true -> - proc_lib:init_ack(Starter, {ok,self()}), - enter( - Module, Opts, CallbackMode, State, Data, - ServerRef, Actions, Parent); - false -> - Error = {callback_mode,CallbackMode}, - proc_lib:init_ack(Starter, {error,Error}), - exit(Error) - end; + {ok,State,Data} -> + proc_lib:init_ack(Starter, {ok,self()}), + enter(Module, Opts, State, Data, ServerRef, [], Parent); + {ok,State,Data,Actions} -> + proc_lib:init_ack(Starter, {ok,self()}), + enter(Module, Opts, State, Data, ServerRef, Actions, Parent); {stop,Reason} -> gen:unregister_name(ServerRef), proc_lib:init_ack(Starter, {error,Reason}), @@ -601,8 +663,16 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> proc_lib:init_ack(Starter, ignore), exit(normal); _ -> - Error = {bad_return_value,Result}, + Name = gen:get_proc_name(ServerRef), + gen:unregister_name(ServerRef), + Error = {bad_return_from_init,Result}, proc_lib:init_ack(Starter, {error,Error}), + error_info( + error, Error, ?STACKTRACE(), + #{name => Name, + callback_mode => undefined, + state_enter => false}, + [], [], undefined), exit(Error) end. @@ -612,12 +682,10 @@ init_result(Starter, Parent, ServerRef, Module, Result, Opts) -> system_continue(Parent, Debug, S) -> loop(Parent, Debug, S). -system_terminate( - Reason, _Parent, Debug, - #{state := State, data := Data, postponed := P} = S) -> +system_terminate(Reason, _Parent, Debug, S) -> terminate( exit, Reason, ?STACKTRACE(), - Debug, S, [], State, Data, P). + Debug, S, []). system_code_change( #{module := Module, @@ -630,11 +698,9 @@ system_code_change( Result -> Result end of - {NewCallbackMode,NewState,NewData} -> - callback_mode(NewCallbackMode) orelse - error({callback_mode,NewCallbackMode}), + {ok,NewState,NewData} -> {ok, - S#{callback_mode := NewCallbackMode, + S#{callback_mode := undefined, state := NewState, data := NewData}}; {ok,_} = Error -> @@ -656,7 +722,7 @@ system_replace_state( format_status( Opt, [PDict,SysState,Parent,Debug, - #{name := Name, postponed := P, state := State, data := Data} = S]) -> + #{name := Name, postponed := P} = S]) -> Header = gen:format_status_header("Status for state machine", Name), Log = sys:get_debug(log, Debug, []), [{header,Header}, @@ -665,7 +731,7 @@ format_status( {"Parent",Parent}, {"Logged Events",Log}, {"Postponed",P}]} | - case format_status(Opt, PDict, S, State, Data) of + case format_status(Opt, PDict, S) of L when is_list(L) -> L; T -> [T] end]. @@ -675,14 +741,18 @@ format_status( %% them, not as the real erlang messages. Use trace for that. %%--------------------------------------------------------------------------- -print_event(Dev, {in,Event}, {Name,_}) -> +print_event(Dev, {in,Event}, {Name,State}) -> io:format( - Dev, "*DBG* ~p received ~s~n", - [Name,event_string(Event)]); -print_event(Dev, {out,Reply,{To,_Tag}}, {Name,_}) -> + Dev, "*DBG* ~p receive ~s in state ~p~n", + [Name,event_string(Event),State]); +print_event(Dev, {out,Reply,{To,_Tag}}, {Name,State}) -> io:format( - Dev, "*DBG* ~p sent ~p to ~p~n", - [Name,Reply,To]); + Dev, "*DBG* ~p send ~p to ~p from state ~p~n", + [Name,Reply,To,State]); +print_event(Dev, {terminate,Reason}, {Name,State}) -> + io:format( + Dev, "*DBG* ~p terminate ~p in state ~p~n", + [Name,Reason,State]); print_event(Dev, {Tag,Event,NextState}, {Name,State}) -> StateString = case NextState of @@ -741,7 +811,8 @@ loop(Parent, Debug, #{hibernate := Hibernate} = S) -> end. %% Entry point for wakeup_from_hibernate/3 -loop_receive(Parent, Debug, #{timer := Timer} = S) -> +loop_receive( + Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) -> receive Msg -> case Msg of @@ -752,34 +823,28 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> sys:handle_system_msg( Req, Pid, Parent, ?MODULE, Debug, S, Hibernate); {'EXIT',Parent,Reason} = EXIT -> - #{state := State, data := Data, postponed := P} = S, %% 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], State, Data, P); - {timeout,Timer,Content} when Timer =/= undefined -> - loop_receive_result( - Parent, Debug, S, {timeout,Content}); - _ -> - %% Cancel Timer if running - case Timer of - undefined -> - ok; + exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]); + {timeout,TimerRef,TimerMsg} -> + case TimerRefs of + #{TimerRef := TimerType} -> + Event = {TimerType,TimerMsg}, + %% Unregister the triggered timeout + loop_receive_result( + Parent, Debug, S, + maps:remove(TimerRef, TimerRefs), + maps:remove(TimerType, TimerTypes), + Event); _ -> - case erlang:cancel_timer(Timer) of - TimeLeft when is_integer(TimeLeft) -> - ok; - false -> - receive - {timeout,Timer,_} -> - ok - after 0 -> - ok - end - end - end, + Event = {info,Msg}, + loop_receive_result( + Parent, Debug, S, + TimerRefs, TimerTypes, Event) + end; + _ -> Event = case Msg of {'$gen_call',From,Request} -> @@ -789,388 +854,629 @@ loop_receive(Parent, Debug, #{timer := Timer} = S) -> _ -> {info,Msg} end, - loop_receive_result(Parent, Debug, S, Event) + loop_receive_result( + Parent, Debug, S, + TimerRefs, TimerTypes, Event) end end. loop_receive_result( - Parent, Debug, - #{state := State, - data := Data, - postponed := P} = S, - Event) -> - %% The engine state map S is now dismantled - %% and will not be restored until we return to loop/3. - %% - %% The fields 'callback_mode', 'module', and 'name' are still valid. - %% The fields 'state', 'data', and 'postponed' are held in arguments. - %% The fields 'timer' and 'hibernate' will be recalculated. + 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 %% NewDebug = sys_debug(Debug, S, State, {in,Event}), %% Here the queue of not yet handled events is created Events = [], Hibernate = false, loop_event( - Parent, NewDebug, S, Events, State, Data, P, Event, Hibernate). + Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, Hibernate). -%% Process the event queue, or if it is empty -%% loop back to loop/3 to receive a new event -loop_events( - Parent, Debug, S, [Event|Events], - State, Data, P, Hibernate, _Timeout) -> +%% Entry point for handling an event, received or enqueued +loop_event( + Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes, + Events, {Type,Content} = Event, Hibernate) -> %% - %% If there was a state timer requested we just ignore that - %% since we have events to handle which cancels the timer - loop_event( - Parent, Debug, S, Events, State, Data, P, Event, Hibernate); -loop_events( - Parent, Debug, S, [], - State, Data, P, Hibernate, Timeout) -> - case Timeout of - {timeout,0,EventContent} -> - %% Immediate timeout - simulate it - %% so we do not get the timeout message - %% after any received event - loop_event( - Parent, Debug, S, [], - State, Data, P, {timeout,EventContent}, Hibernate); - {timeout,Time,EventContent} -> - %% Actually start a timer - Timer = erlang:start_timer(Time, self(), EventContent), - loop_events_done( - Parent, Debug, S, Timer, State, Data, P, Hibernate); - undefined -> - %% No state timeout has been requested - Timer = undefined, - loop_events_done( - Parent, Debug, S, Timer, State, Data, P, Hibernate) + %% If 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 + %% 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} = + parse_event_result( + true, Debug, NewS, Result, + Events, Event, State, Data), + loop_event_actions( + Parent, Debug, S, NewTimerRefs, NewTimerTypes, + Events, Event, NextState, NewData, Actions); + {Class,Reason,Stacktrace} -> + terminate( + 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) -> + case parse_actions(Debug, S, State, Actions) of + {ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} -> + if + StateEnter, NextState =/= State -> + loop_event_enter( + Parent, NewDebug, S, TimerRefs, TimerTypes, + 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, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR) + end; + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{data := NewData}, [Event|Events]) + end. + +loop_event_enter( + Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes, + 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); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{state := NextState, data := NewData}, + [Event|Events]) end. + +loop_event_enter_actions( + Parent, Debug, S, TimerRefs, TimerTypes, + Events, Event, NextState, NewData, + Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) -> + case + parse_enter_actions( + 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); + {Class,Reason,Stacktrace} -> + terminate( + Class, Reason, Stacktrace, + Debug, S#{state := NextState, data := NewData}, + [Event|Events]) + end. + +loop_event_result( + Parent, Debug, + #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0, + Events, Event, 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 + case Postpone of + true -> + {sys_debug(Debug, S, State, {postpone,Event,State}), + [Event|P_0]}; + false -> + {sys_debug(Debug, S, State, {consume,Event,State}), + P_0} + end, + {Events_1,NewP,{TimerRefs_1,TimerTypes_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}}; + true -> + {lists:reverse(P_1, Events),[], + cancel_timer_by_type( + state_timeout, TimerRefs_0, TimerTypes_0)} + end, + {TimerRefs_2,TimerTypes_2,TimeoutEvents} = + %% Stop and start timers non-event timers + parse_timers(TimerRefs_1, TimerTypes_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_done(Parent, Debug, S, Timer, State, Data, P, Hibernate) -> +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 := Timer}, - loop(Parent, Debug, NewS). + 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). -loop_event( - Parent, Debug, + + +%%--------------------------------------------------------------------------- +%% Server loop helpers + +call_callback_mode(#{module := Module} = S) -> + try Module:callback_mode() of + CallbackMode -> + callback_mode_result(S, CallbackMode) + 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. + +callback_mode_result(S, CallbackMode) -> + case + parse_callback_mode( + if + is_atom(CallbackMode) -> + [CallbackMode]; + true -> + CallbackMode + end, undefined, false) + of + {undefined,_} -> + {error, + {bad_return_from_callback_mode,CallbackMode}, + ?STACKTRACE()}; + {CBMode,StateEnter} -> + {ok, + S#{ + callback_mode := CBMode, + state_enter := StateEnter}} + end. + +parse_callback_mode([], CBMode, StateEnter) -> + {CBMode,StateEnter}; +parse_callback_mode([H|T], CBMode, StateEnter) -> + case callback_mode(H) of + true -> + parse_callback_mode(T, H, StateEnter); + false -> + case H of + state_enter -> + parse_callback_mode(T, CBMode, true); + _ -> + {undefined,StateEnter} + end + end; +parse_callback_mode(_, _CBMode, StateEnter) -> + {undefined,StateEnter}. + + +call_state_function( + #{callback_mode := undefined} = S, + Type, Content, State, Data) -> + case call_callback_mode(S) of + {ok,NewS} -> + call_state_function(NewS, Type, Content, State, Data); + Error -> + Error + end; +call_state_function( #{callback_mode := CallbackMode, module := Module} = S, - Events, - State, Data, P, {Type,Content} = Event, Hibernate) -> - %% - %% If 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 - %% might depend on i.e collect garbage which - %% would have happened if we actually hibernated - %% and immediately was awakened - Hibernate andalso garbage_collect(), - %% + Type, Content, State, Data) -> try case CallbackMode of state_functions -> - Module:State(Type, Content, Data); + erlang:apply(Module, State, [Type,Content,Data]); handle_event_function -> Module:handle_event(Type, Content, State, Data) - end of + end + of Result -> - loop_event_result( - Parent, Debug, S, Events, State, Data, P, Event, Result) + {ok,Result,S} catch Result -> - loop_event_result( - Parent, Debug, S, Events, State, Data, P, Event, Result); - error:badarg when CallbackMode =:= state_functions -> + {ok,Result,S}; + error:badarg -> case erlang:get_stacktrace() of - [{erlang,apply,[Module,State,_],_}|Stacktrace] -> - Args = [Type,Content,Data], - terminate( - error, - {undef_state_function,{Module,State,Args}}, - Stacktrace, - Debug, S, [Event|Events], State, Data, P); + [{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 -> - terminate( - error, badarg, Stacktrace, - Debug, S, [Event|Events], State, Data, P) + {error,badarg,Stacktrace} end; error:undef -> - %% Process an undef to check for the simple mistake + %% 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, - _} + [{Module,State,[Type,Content,Data]=Args,_} |Stacktrace] - when CallbackMode =:= state_functions -> - terminate( - error, - {undef_state_function,{Module,State,Args}}, - Stacktrace, - Debug, S, [Event|Events], State, Data, P); - [{Module,handle_event, - [Type,Content,State,Data]=Args, - _} + 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 -> - terminate( - error, - {undef_state_function,{Module,handle_event,Args}}, - Stacktrace, - Debug, S, [Event|Events], State, Data, P); + when CallbackMode =:= handle_event_function -> + {error, + {undef_state_function,{Module,handle_event,Args}}, + Stacktrace}; Stacktrace -> - terminate( - error, undef, Stacktrace, - Debug, S, [Event|Events], State, Data, P) + {error,undef,Stacktrace} end; Class:Reason -> - Stacktrace = erlang:get_stacktrace(), - terminate( - Class, Reason, Stacktrace, - Debug, S, [Event|Events], State, Data, P) + {Class,Reason,erlang:get_stacktrace()} end. + %% Interpret all callback return variants -loop_event_result( - Parent, Debug, S, Events, State, Data, P, Event, Result) -> +parse_event_result( + AllowStateChange, Debug, S, Result, Events, Event, State, Data) -> case Result of stop -> terminate( - exit, normal, ?STACKTRACE(), - Debug, S, [Event|Events], State, Data, P); + exit, normal, ?STACKTRACE(), Debug, S, [Event|Events]); {stop,Reason} -> terminate( - exit, Reason, ?STACKTRACE(), - Debug, S, [Event|Events], State, Data, P); + exit, Reason, ?STACKTRACE(), Debug, S, [Event|Events]); {stop,Reason,NewData} -> terminate( exit, Reason, ?STACKTRACE(), - Debug, S, [Event|Events], State, NewData, P); + Debug, S#{data := NewData}, [Event|Events]); {stop_and_reply,Reason,Replies} -> Q = [Event|Events], reply_then_terminate( exit, Reason, ?STACKTRACE(), - Debug, S, Q, State, Data, P, Replies); + Debug, S, Q, Replies); {stop_and_reply,Reason,Replies,NewData} -> Q = [Event|Events], reply_then_terminate( exit, Reason, ?STACKTRACE(), - Debug, S, Q, State, NewData, P, Replies); - {next_state,NextState,NewData} -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, []); - {next_state,NextState,NewData,Actions} -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions); + Debug, S#{data := NewData}, Q, Replies); + {next_state,State,NewData} -> + {NewData,State,[]}; + {next_state,NextState,NewData} when AllowStateChange -> + {NewData,NextState,[]}; + {next_state,State,NewData,Actions} -> + {NewData,State,Actions}; + {next_state,NextState,NewData,Actions} when AllowStateChange -> + {NewData,NextState,Actions}; {keep_state,NewData} -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, State, []); + {NewData,State,[]}; {keep_state,NewData,Actions} -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, State, Actions); + {NewData,State,Actions}; keep_state_and_data -> - loop_event_actions( - Parent, Debug, S, Events, - State, Data, P, Event, State, []); + {Data,State,[]}; {keep_state_and_data,Actions} -> - loop_event_actions( - Parent, Debug, S, Events, - State, Data, P, Event, State, Actions); + {Data,State,Actions}; _ -> terminate( - error, {bad_return_value,Result}, ?STACKTRACE(), - Debug, S, [Event|Events], State, Data, P) + error, + {bad_return_from_state_function,Result}, + ?STACKTRACE(), + Debug, S, [Event|Events]) end. -loop_event_actions( - Parent, Debug, S, Events, State, NewData, P, Event, NextState, Actions) -> - Postpone = false, % Shall we postpone this event; boolean() + +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, - Timeout = undefined, - NextEvents = [], - loop_event_actions( - Parent, Debug, S, Events, State, NewData, P, Event, NextState, - if - is_list(Actions) -> - Actions; - true -> - [Actions] - end, - Postpone, Hibernate, Timeout, NextEvents). + TimeoutsR = [], + Postpone = false, + NextEventsR = [], + parse_actions( + Debug, S, State, listify(Actions), + Hibernate, TimeoutsR, Postpone, NextEventsR). %% -%% Process all actions -loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, [Action|Actions], - Postpone, Hibernate, Timeout, NextEvents) -> +parse_actions( + Debug, _S, _State, [], + Hibernate, TimeoutsR, Postpone, NextEventsR) -> + {ok,Debug,Hibernate,TimeoutsR,Postpone,NextEventsR}; +parse_actions( + Debug, S, State, [Action|Actions], + Hibernate, TimeoutsR, Postpone, NextEventsR) -> case Action of %% Actual actions {reply,From,Reply} -> case from(From) of true -> NewDebug = do_reply(Debug, S, State, From, Reply), - loop_event_actions( - Parent, NewDebug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, Hibernate, Timeout, NextEvents); + parse_actions( + NewDebug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, NextEventsR); false -> - terminate( - error, {bad_action,Action}, ?STACKTRACE(), - Debug, S, [Event|Events], State, NewData, P) - end; - {next_event,Type,Content} -> - case event_type(Type) of - true -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, Hibernate, Timeout, - [{Type,Content}|NextEvents]); - false -> - terminate( - error, {bad_action,Action}, ?STACKTRACE(), - Debug, S, [Event|Events], State, NewData, P) + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()} end; %% Actions that set options - {postpone,NewPostpone} when is_boolean(NewPostpone) -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - NewPostpone, Hibernate, Timeout, NextEvents); - {postpone,_} -> - terminate( - error, {bad_action,Action}, ?STACKTRACE(), - Debug, S, [Event|Events], State, NewData, P); - postpone -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - true, Hibernate, Timeout, NextEvents); {hibernate,NewHibernate} when is_boolean(NewHibernate) -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, NewHibernate, Timeout, NextEvents); + parse_actions( + Debug, S, State, Actions, + NewHibernate, TimeoutsR, Postpone, NextEventsR); {hibernate,_} -> - terminate( - error, {bad_action,Action}, ?STACKTRACE(), - Debug, S, [Event|Events], State, NewData, P); + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()}; hibernate -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, true, Timeout, NextEvents); - {timeout,infinity,_} -> % Clear timer - it will never trigger - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, Hibernate, undefined, NextEvents); - {timeout,Time,_} = NewTimeout when is_integer(Time), Time >= 0 -> - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, Hibernate, NewTimeout, NextEvents); + 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,_,_} -> - terminate( - error, {bad_action,Action}, ?STACKTRACE(), - Debug, S, [Event|Events], State, NewData, P); - infinity -> % Clear timer - it will never trigger - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, Hibernate, undefined, NextEvents); + {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 -> - NewTimeout = {timeout,Time,Time}, - loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P, Event, NextState, Actions, - Postpone, Hibernate, NewTimeout, NextEvents); + Timeout = {timeout,Time,Time}, + parse_actions( + Debug, S, State, Actions, + Hibernate, [Timeout|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 -> + parse_actions( + Debug, S, State, Actions, + Hibernate, TimeoutsR, true, NextEventsR); + {next_event,Type,Content} -> + case event_type(Type) of + true when NextEventsR =/= forbidden -> + NewDebug = + sys_debug(Debug, S, State, {in,{Type,Content}}), + parse_actions( + NewDebug, S, State, Actions, + Hibernate, TimeoutsR, Postpone, + [{Type,Content}|NextEventsR]); + _ -> + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()} + end; _ -> - terminate( - error, {bad_action,Action}, ?STACKTRACE(), - Debug, S, [Event|Events], State, NewData, P) - end; + {error, + {bad_action_from_state_function,Action}, + ?STACKTRACE()} + end. + + +%% Stop and start timers as well as create timeout zero events +%% and pending event timer %% -%% End of actions list -loop_event_actions( - Parent, Debug, S, Events, - State, NewData, P0, Event, NextState, [], - Postpone, Hibernate, Timeout, NextEvents) -> - %% - %% All options have been collected and next_events are buffered. - %% Do the actual state transition. - %% - P1 = % Move current event to postponed if Postpone - case Postpone of - true -> - [Event|P0]; - false -> - P0 - end, - {Q2,P} = % Move all postponed events to queue if state change - if - NextState =:= State -> - {Events,P1}; - true -> - {lists:reverse(P1, Events),[]} - end, - %% Place next events first in queue - Q = lists:reverse(NextEvents, Q2), - %% - NewDebug = - sys_debug( - Debug, S, State, - case Postpone of - true -> - {postpone,Event,NextState}; - false -> - {consume,Event,NextState} - end), - loop_events( - Parent, NewDebug, S, Q, NextState, NewData, P, Hibernate, Timeout). +%% Stop and start timers non-event timers +parse_timers(TimerRefs, TimerTypes, TimeoutsR) -> + parse_timers(TimerRefs, TimerTypes, TimeoutsR, #{}, []). +%% +parse_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) -> + {TimerRefs,TimerTypes,TimeoutEvents}; +parse_timers( + TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) -> + {TimerType,Time,TimerMsg} = Timeout, + case Seen of + #{TimerType := _} -> + %% Type seen before - ignore + parse_timers( + TimerRefs, TimerTypes, 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 + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, TimeoutEvents); + TimerType =:= timeout -> + %% Handle event timer later + parse_timers( + NewTimerRefs, NewTimerTypes, TimeoutsR, + NewSeen, [Timeout|TimeoutEvents]); + Time =:= 0 -> + %% Handle zero time timeouts later + TimeoutEvent = {TimerType,TimerMsg}, + parse_timers( + NewTimerRefs, NewTimerTypes, 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) + 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]). + + %%--------------------------------------------------------------------------- %% Server helpers reply_then_terminate( Class, Reason, Stacktrace, - Debug, S, Q, State, Data, P, Replies) -> + Debug, #{state := State} = S, Q, Replies) -> if is_list(Replies) -> do_reply_then_terminate( Class, Reason, Stacktrace, - Debug, S, Q, State, Data, P, Replies); + Debug, S, Q, Replies, State); true -> do_reply_then_terminate( Class, Reason, Stacktrace, - Debug, S, Q, State, Data, P, [Replies]) + Debug, S, Q, [Replies], State) end. %% do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, State, Data, P, []) -> - terminate(Class, Reason, Stacktrace, Debug, S, Q, State, Data, P); + Class, Reason, Stacktrace, Debug, S, Q, [], _State) -> + terminate(Class, Reason, Stacktrace, Debug, S, Q); do_reply_then_terminate( - Class, Reason, Stacktrace, Debug, S, Q, State, Data, P, [R|Rs]) -> + Class, Reason, Stacktrace, Debug, S, Q, [R|Rs], State) -> case R of {reply,{_To,_Tag}=From,Reply} -> NewDebug = do_reply(Debug, S, State, From, Reply), do_reply_then_terminate( - Class, Reason, Stacktrace, - NewDebug, S, Q, State, Data, P, Rs); + Class, Reason, Stacktrace, NewDebug, S, Q, Rs, State); _ -> terminate( - error, {bad_action,R}, ?STACKTRACE(), - Debug, S, Q, State, Data, P) + error, + {bad_reply_action_from_state_function,R}, + ?STACKTRACE(), + Debug, S, Q) end. do_reply(Debug, S, State, From, Reply) -> @@ -1180,7 +1486,9 @@ do_reply(Debug, S, State, From, Reply) -> terminate( Class, Reason, Stacktrace, - Debug, #{module := Module} = S, Q, State, Data, P) -> + Debug, + #{module := Module, state := State, data := Data, postponed := P} = S, + Q) -> try Module:terminate(Reason, State, Data) of _ -> ok catch @@ -1188,19 +1496,25 @@ terminate( C:R -> ST = erlang:get_stacktrace(), error_info( - C, R, ST, Debug, S, Q, P, - format_status(terminate, get(), S, State, Data)), + C, R, ST, S, Q, P, + format_status(terminate, get(), S)), + sys:print_log(Debug), erlang:raise(C, R, ST) end, - case Reason of - normal -> ok; - shutdown -> ok; - {shutdown,_} -> ok; - _ -> - error_info( - Class, Reason, Stacktrace, Debug, S, Q, P, - format_status(terminate, get(), S, State, Data)) - end, + _ = + case Reason of + normal -> + sys_debug(Debug, S, State, {terminate,Reason}); + shutdown -> + sys_debug(Debug, S, State, {terminate,Reason}); + {shutdown,_} -> + sys_debug(Debug, S, State, {terminate,Reason}); + _ -> + error_info( + Class, Reason, Stacktrace, S, Q, P, + format_status(terminate, get(), S)), + sys:print_log(Debug) + end, case Stacktrace of [] -> erlang:Class(Reason); @@ -1209,8 +1523,10 @@ terminate( end. error_info( - Class, Reason, Stacktrace, Debug, - #{name := Name, callback_mode := CallbackMode}, + Class, Reason, Stacktrace, + #{name := Name, + callback_mode := CallbackMode, + state_enter := StateEnter}, Q, P, FmtData) -> {FixedReason,FixedStacktrace} = case Stacktrace of @@ -1237,6 +1553,13 @@ error_info( end; _ -> {Reason,Stacktrace} end, + CBMode = + case StateEnter of + true -> + [CallbackMode,state_enter]; + false -> + CallbackMode + end, error_logger:format( "** State machine ~p terminating~n" ++ case Q of @@ -1263,8 +1586,9 @@ error_info( [] -> []; [Event|_] -> [Event] end] ++ - [FmtData,Class,FixedReason, - CallbackMode] ++ + [FmtData, + Class,FixedReason, + CBMode] ++ case Q of [_|[_|_] = Events] -> [Events]; _ -> [] @@ -1276,13 +1600,13 @@ error_info( case FixedStacktrace of [] -> []; _ -> [FixedStacktrace] - end), - sys:print_log(Debug), - ok. + end). %% Call Module:format_status/2 or return a default value -format_status(Opt, PDict, #{module := Module}, State, Data) -> +format_status( + Opt, PDict, + #{module := Module, state := State, data := Data}) -> case erlang:function_exported(Module, format_status, 2) of true -> try Module:format_status(Opt, [PDict,State,Data]) @@ -1291,7 +1615,7 @@ format_status(Opt, PDict, #{module := Module}, State, Data) -> _:_ -> format_status_default( Opt, State, - "Module:format_status/2 crashed") + atom_to_list(Module) ++ ":format_status/2 crashed") end; false -> format_status_default(Opt, State, Data) @@ -1299,10 +1623,42 @@ format_status(Opt, PDict, #{module := Module}, State, Data) -> %% The default Module:format_status/2 format_status_default(Opt, State, Data) -> - SSD = {State,Data}, + StateData = {State,Data}, case Opt of terminate -> - SSD; + StateData; _ -> - [{data,[{"State",SSD}]}] + [{data,[{"State",StateData}]}] + end. + +listify(Item) when is_list(Item) -> + Item; +listify(Item) -> + [Item]. + +%% Cancel timer if running, otherwise no op +cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) -> + case TimerTypes of + #{TimerType := TimerRef} -> + cancel_timer(TimerRef), + {maps:remove(TimerRef, TimerRefs), + maps:remove(TimerType, TimerTypes)}; + #{} -> + {TimerRefs,TimerTypes} + 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. diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl index c0eea652e7..98745b13f3 100644 --- a/lib/stdlib/src/ms_transform.erl +++ b/lib/stdlib/src/ms_transform.erl @@ -451,6 +451,8 @@ check_type(_,[{record,_,_,_}],ets) -> ok; check_type(_,[{cons,_,_,_}],dbg) -> ok; +check_type(_,[{nil,_}],dbg) -> + ok; check_type(Line0,[{match,_,{var,_,_},X}],Any) -> check_type(Line0,[X],Any); check_type(Line0,[{match,_,X,{var,_,_}}],Any) -> diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl index 82a3a2be4f..28f37ef8bf 100644 --- a/lib/stdlib/src/shell.erl +++ b/lib/stdlib/src/shell.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2015. All Rights Reserved. +%% Copyright Ericsson AB 1996-2016. All Rights Reserved. %% %% Licensed under the Apache License, Version 2.0 (the "License"); %% you may not use this file except in compliance with the License. @@ -768,6 +768,8 @@ used_records({call,_,{atom,_,record_info},[A,{atom,_,Name}]}) -> {name, Name, A}; used_records({call,Line,{tuple,_,[M,F]},As}) -> used_records({call,Line,{remote,Line,M,F},As}); +used_records({type,_,record,[{atom,_,Name}|Fs]}) -> + {name, Name, Fs}; used_records(T) when is_tuple(T) -> {expr, tuple_to_list(T)}; used_records(E) -> diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src index 9877662743..e917b7ea1f 100644 --- a/lib/stdlib/src/stdlib.appup.src +++ b/lib/stdlib/src/stdlib.appup.src @@ -18,9 +18,9 @@ %% %CopyrightEnd% {"%VSN%", %% Up from - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* + [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* {<<"2\\.[5-8](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.* %% Down to - max one major revision back - [{<<"3\\.0(\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* + [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.* {<<"2\\.[5-8](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-18.* }. diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index c81e72689c..1cd65fbf18 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -1087,6 +1087,10 @@ wait_dynamic_children(#child{restart_type=RType} = Child, Pids, Sz, wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, TRef, EStack); + {'DOWN', _MRef, process, Pid, {shutdown, _}} -> + wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, + TRef, EStack); + {'DOWN', _MRef, process, Pid, normal} when RType =/= permanent -> wait_dynamic_children(Child, ?SETS:del_element(Pid, Pids), Sz-1, TRef, EStack); diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl index f8ba6f18e9..340cc21390 100644 --- a/lib/stdlib/src/zip.erl +++ b/lib/stdlib/src/zip.erl @@ -279,7 +279,8 @@ do_openzip_get(F, #openzip{files = Files, in = In0, input = Input, case file_name_search(F, Files) of {#zip_file{offset = Offset},_}=ZFile -> In1 = Input({seek, bof, Offset}, In0), - case get_z_file(In1, Z, Input, Output, [], fun silent/1, CWD, ZFile) of + case get_z_file(In1, Z, Input, Output, [], fun silent/1, + CWD, ZFile, fun all/1) of {file, R, _In2} -> {ok, R}; _ -> throw(file_not_found) end; @@ -1403,9 +1404,10 @@ get_z_files([{#zip_file{offset = Offset},_} = ZFile | Rest], Z, In0, true -> In1 = Input({seek, bof, Offset}, In0), {In2, Acc1} = - case get_z_file(In1, Z, Input, Output, OpO, FB, CWD, ZFile) of + case get_z_file(In1, Z, Input, Output, OpO, FB, + CWD, ZFile, Filter) of {file, GZD, Inx} -> {Inx, [GZD | Acc0]}; - {dir, Inx} -> {Inx, Acc0} + {_, Inx} -> {Inx, Acc0} end, get_z_files(Rest, Z, In2, Opts, Acc1); _ -> @@ -1413,7 +1415,8 @@ get_z_files([{#zip_file{offset = Offset},_} = ZFile | Rest], Z, In0, end. %% get a file from the archive, reading chunks -get_z_file(In0, Z, Input, Output, OpO, FB, CWD, {ZipFile,Extra}) -> +get_z_file(In0, Z, Input, Output, OpO, FB, + CWD, {ZipFile,Extra}, Filter) -> case Input({read, ?LOCAL_FILE_HEADER_SZ}, In0) of {eof, In1} -> {eof, In1}; @@ -1433,29 +1436,64 @@ get_z_file(In0, Z, Input, Output, OpO, FB, CWD, {ZipFile,Extra}) -> end, {BFileN, In3} = Input({read, FileNameLen + ExtraLen}, In1), {FileName, _} = get_file_name_extra(FileNameLen, ExtraLen, BFileN), - FileName1 = add_cwd(CWD, FileName), - case lists:last(FileName) of - $/ -> - %% perhaps this should always be done? - Output({ensure_dir,FileName1},[]), - {dir, In3}; - _ -> - %% FileInfo = local_file_header_to_file_info(LH) - %%{Out, In4, CRC, UncompSize} = - {Out, In4, CRC, _UncompSize} = - get_z_data(CompMethod, In3, FileName1, - CompSize, Input, Output, OpO, Z), - In5 = skip_z_data_descriptor(GPFlag, Input, In4), - %% TODO This should be fixed some day: - %% In5 = Input({set_file_info, FileName, FileInfo#file_info{size=UncompSize}}, In4), - FB(FileName), - CRC =:= CRC32 orelse throw({bad_crc, FileName}), - {file, Out, In5} + ReadAndWrite = + case check_valid_location(CWD, FileName) of + {true,FileName1} -> + true; + {false,FileName1} -> + Filter({ZipFile#zip_file{name = FileName1},Extra}) + end, + case ReadAndWrite of + true -> + case lists:last(FileName) of + $/ -> + %% perhaps this should always be done? + Output({ensure_dir,FileName1},[]), + {dir, In3}; + _ -> + %% FileInfo = local_file_header_to_file_info(LH) + %%{Out, In4, CRC, UncompSize} = + {Out, In4, CRC, _UncompSize} = + get_z_data(CompMethod, In3, FileName1, + CompSize, Input, Output, OpO, Z), + In5 = skip_z_data_descriptor(GPFlag, Input, In4), + %% TODO This should be fixed some day: + %% In5 = Input({set_file_info, FileName, + %% FileInfo#file_info{size=UncompSize}}, In4), + FB(FileName), + CRC =:= CRC32 orelse throw({bad_crc, FileName}), + {file, Out, In5} + end; + false -> + {ignore, In3} end; _ -> throw(bad_local_file_header) end. +%% make sure FileName doesn't have relative path that points over CWD +check_valid_location(CWD, FileName) -> + %% check for directory traversal exploit + case check_dir_level(filename:split(FileName), 0) of + {FileOrDir,Level} when Level < 0 -> + CWD1 = if CWD == "" -> "./"; + true -> CWD + end, + error_logger:format("Illegal path: ~ts, extracting in ~ts~n", + [add_cwd(CWD,FileName),CWD1]), + {false,add_cwd(CWD, FileOrDir)}; + _ -> + {true,add_cwd(CWD, FileName)} + end. + +check_dir_level([FileOrDir], Level) -> + {FileOrDir,Level}; +check_dir_level(["." | Parts], Level) -> + check_dir_level(Parts, Level); +check_dir_level([".." | Parts], Level) -> + check_dir_level(Parts, Level-1); +check_dir_level([_Dir | Parts], Level) -> + check_dir_level(Parts, Level+1). get_file_name_extra(FileNameLen, ExtraLen, B) -> case B of |