From 3c52776dffef6fcc4277f2ca754003cef60aa0dd Mon Sep 17 00:00:00 2001 From: Paul Guyot Date: Tue, 11 Nov 2025 16:06:11 +0100 Subject: [PATCH] Add `sys` implementation for gleam/otp - Factorize some `gen_server`/`gen_statem` code into new `gen` module - Extend `proc_lib` to add `start_monitor` and use it with `gen_server` - Bump CI erlfmt to v1.7.0 (v1.1.0 and v1.7.0 only disagree on newly introduce `gen` module's moduledoc attribute). - Remove unnecessary check in `timer_manager:maybe_start/0` as the same check is performed in `gen_server:start/4` Signed-off-by: Paul Guyot --- .github/workflows/check-formatting.yaml | 4 +- CHANGELOG.md | 1 + libs/eavmlib/src/timer_manager.erl | 11 +- libs/estdlib/src/CMakeLists.txt | 2 + libs/estdlib/src/gen.erl | 91 +++++ libs/estdlib/src/gen_server.erl | 320 ++++++++--------- libs/estdlib/src/gen_statem.erl | 21 +- libs/estdlib/src/proc_lib.erl | 56 ++- libs/estdlib/src/sys.erl | 436 ++++++++++++++++++++++++ tests/libs/estdlib/CMakeLists.txt | 1 + tests/libs/estdlib/test_gen_server.erl | 89 ++++- tests/libs/estdlib/test_proc_lib.erl | 40 ++- tests/libs/estdlib/test_sys.erl | 192 +++++++++++ 13 files changed, 1073 insertions(+), 191 deletions(-) create mode 100644 libs/estdlib/src/gen.erl create mode 100644 libs/estdlib/src/sys.erl create mode 100644 tests/libs/estdlib/test_sys.erl diff --git a/.github/workflows/check-formatting.yaml b/.github/workflows/check-formatting.yaml index e87c837921..79a67f96b1 100644 --- a/.github/workflows/check-formatting.yaml +++ b/.github/workflows/check-formatting.yaml @@ -56,14 +56,14 @@ jobs: erlfmt-check: runs-on: ubuntu-24.04 - container: erlang:27 + container: erlang:28 steps: - uses: actions/checkout@v4 - name: "Check formatting with Erlang fmt" run: | cd .. - git clone --depth 1 -b v1.1.0 https://github.com/WhatsApp/erlfmt.git + git clone --depth 1 -b v1.7.0 https://github.com/WhatsApp/erlfmt.git cd erlfmt rebar3 as release escriptize cd ../AtomVM diff --git a/CHANGELOG.md b/CHANGELOG.md index 18bbf9bc39..a39f5a1555 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -63,6 +63,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Added support for big integers in `binary_to_term/1` and `term_to_binary/1,2` - Added `proc_lib` - Added gen_server support for timeout tuples in callback return actions introduced in OTP-28. +- Added `sys` ### Changed diff --git a/libs/eavmlib/src/timer_manager.erl b/libs/eavmlib/src/timer_manager.erl index f3db0d6bcb..7ed7dea195 100644 --- a/libs/eavmlib/src/timer_manager.erl +++ b/libs/eavmlib/src/timer_manager.erl @@ -39,14 +39,9 @@ start() -> -spec maybe_start() -> {ok, Pod :: pid()}. maybe_start() -> - case erlang:whereis(?SERVER_NAME) of - undefined -> - case start() of - {ok, _Pid} = R -> R; - {error, {already_started, Pid}} -> {ok, Pid} - end; - Pid when is_pid(Pid) -> - {ok, Pid} + case start() of + {ok, _Pid} = R -> R; + {error, {already_started, Pid}} -> {ok, Pid} end. %%----------------------------------------------------------------------------- diff --git a/libs/estdlib/src/CMakeLists.txt b/libs/estdlib/src/CMakeLists.txt index 994bb8877e..fe24f1432e 100644 --- a/libs/estdlib/src/CMakeLists.txt +++ b/libs/estdlib/src/CMakeLists.txt @@ -36,6 +36,7 @@ set(ERLANG_MODULES erts_debug ets file + gen gen_event gen_server gen_statem @@ -58,6 +59,7 @@ set(ERLANG_MODULES math net proc_lib + sys file logger logger_std_h diff --git a/libs/estdlib/src/gen.erl b/libs/estdlib/src/gen.erl new file mode 100644 index 0000000000..7d27c1c01b --- /dev/null +++ b/libs/estdlib/src/gen.erl @@ -0,0 +1,91 @@ +% +% This file is part of AtomVM. +% +% Copyright 2025 Paul Guyot +% +% Licensed under the Apache License, Version 2.0 (the "License"); +% you may not use this file except in compliance with the License. +% You may obtain a copy of the License at +% +% http://www.apache.org/licenses/LICENSE-2.0 +% +% Unless required by applicable law or agreed to in writing, software +% distributed under the License is distributed on an "AS IS" BASIS, +% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +% See the License for the specific language governing permissions and +% limitations under the License. +% +% SPDX-License-Identifier: Apache-2.0 OR LGPL-2.1-or-later +% + +%%----------------------------------------------------------------------------- +%% This module implements common code in gen_* modules, following what +%% Erlang/OTP does with gen module. However, none of the functions exported +%% here are public interface. +%%----------------------------------------------------------------------------- + +-module(gen). +-moduledoc false. + +-export([ + call/4, + cast/2, + reply/2 +]). + +-type server_ref() :: atom() | pid(). +-type from() :: {pid(), reference()}. + +%% @private +-spec call(ServerRef :: server_ref(), Label :: atom(), Request :: term(), Timeout :: timeout()) -> + Reply :: term() | {error, Reason :: term()}. +call(ServerRef, Label, Request, Timeout) -> + MonitorRef = monitor(process, ServerRef), + ok = + try + ServerRef ! {Label, {self(), MonitorRef}, Request}, + ok + catch + error:badarg -> + % Process no longer exists, monitor will send a message + ok + end, + receive + {'DOWN', MonitorRef, process, _, {E, []} = _Reason} -> + exit(E); + {'DOWN', MonitorRef, process, _, {_E, _L} = Reason} -> + exit(Reason); + {'DOWN', MonitorRef, process, _, Atom} when is_atom(Atom) -> + exit(Atom); + {MonitorRef, Reply} -> + demonitor(MonitorRef, [flush]), + Reply + after Timeout -> + % If Timeout is small enough (0), the error message might be timeout + % instead of noproc as there could be a race condition with the monitor. + demonitor(MonitorRef, [flush]), + exit(timeout) + end. + +%% @private +-spec cast(ServerRef :: server_ref(), Message :: any()) -> ok. +cast(ServerRef, Message) -> + try + ServerRef ! {'$gen_cast', Message}, + ok + catch + error:_ -> + % Process does not exist, ignore error + ok + end. + +%% @private +-spec reply(From :: from(), Reply :: any()) -> ok. +reply({Pid, Ref}, Reply) -> + try + Pid ! {Ref, Reply}, + ok + catch + _:_ -> + ok + end. diff --git a/libs/estdlib/src/gen_server.erl b/libs/estdlib/src/gen_server.erl index 536be4d78c..25932956b0 100644 --- a/libs/estdlib/src/gen_server.erl +++ b/libs/estdlib/src/gen_server.erl @@ -51,6 +51,7 @@ ]). -export([init_it/4, init_it/5]). +-export([system_continue/3, system_terminate/4, system_code_change/4, system_get_state/1]). -export_type([ server_ref/0, @@ -62,14 +63,15 @@ -record(state, { name = undefined :: atom(), mod :: module(), - mod_state :: term() + mod_state :: term(), + timeout :: {continue, term()} | {timeout, timeout(), Msg :: any()} | timeout() }). -type options() :: list({atom(), term()}). -type start_ret() :: {ok, pid()} | {error, Reason :: term()}. -type start_mon_ret() :: {ok, {Pid :: pid(), MonRef :: reference()}} | {error, Reason :: term()}. -type server_ref() :: atom() | pid(). --type from() :: any(). +-type from() :: {pid(), reference()}. -type init_result(StateType) :: {ok, State :: StateType} @@ -117,31 +119,6 @@ -callback terminate(Reason :: normal | any(), State :: any()) -> any(). -%% @private -do_spawn(Module, Args, Options, SpawnOpts) -> - PidOrMonRet = spawn_opt(?MODULE, init_it, [self(), Module, Args, Options], SpawnOpts), - case wait_ack(PidOrMonRet) of - ok -> {ok, PidOrMonRet}; - {error, Reason} -> {error, Reason} - end. - -%% @private -do_spawn(Name, Module, Args, Options, SpawnOpts) -> - Pid = spawn_opt(?MODULE, init_it, [self(), Name, Module, Args, Options], SpawnOpts), - case wait_ack(Pid) of - ok -> {ok, Pid}; - {error, Reason} -> {error, Reason} - end. - -%% @private -spawn_if_not_registered(Name, Module, Args, Options, SpawnOpts) -> - case erlang:whereis(Name) of - undefined -> - do_spawn(Name, Module, Args, [{name, Name} | Options], SpawnOpts); - Pid -> - {error, {already_started, Pid}} - end. - init_it(Starter, Name, Module, Args, Options) -> try erlang:register(Name, self()) of true -> @@ -163,7 +140,7 @@ init_it(Starter, Name, Module, Args, Options) -> ErrorT, S ), - init_ack(Starter, {error, ErrorT}) + proc_lib:init_ack(Starter, {error, ErrorT}) end. init_it(Starter, Module, Args, Options) -> @@ -171,40 +148,34 @@ init_it(Starter, Module, Args, Options) -> try case Module:init(Args) of {ok, ModState} -> - init_ack(Starter, ok), - { - #state{ - name = proplists:get_value(name, Options), - mod = Module, - mod_state = ModState - }, - infinity + proc_lib:init_ack(Starter, {ok, self()}), + #state{ + name = proplists:get_value(name, Options), + mod = Module, + mod_state = ModState, + timeout = infinity }; {ok, ModState, {continue, NewContinue}} -> - init_ack(Starter, ok), - { - #state{ - name = proplists:get_value(name, Options), - mod = Module, - mod_state = ModState - }, - {continue, NewContinue} + proc_lib:init_ack(Starter, {ok, self()}), + #state{ + name = proplists:get_value(name, Options), + mod = Module, + mod_state = ModState, + timeout = {continue, NewContinue} }; {ok, ModState, InitTimeout} -> - init_ack(Starter, ok), - { - #state{ - name = proplists:get_value(name, Options), - mod = Module, - mod_state = ModState - }, - InitTimeout + proc_lib:init_ack(Starter, {ok, self()}), + #state{ + name = proplists:get_value(name, Options), + mod = Module, + mod_state = ModState, + timeout = InitTimeout }; {stop, Reason} -> - init_ack(Starter, {error, {init_stopped, Reason}}), + proc_lib:init_ack(Starter, {error, {init_stopped, Reason}}), undefined; Reply -> - init_ack(Starter, {error, {unexpected_reply_from_init, Reply}}), + proc_lib:init_ack(Starter, {error, {unexpected_reply_from_init, Reply}}), undefined end catch @@ -215,26 +186,12 @@ init_it(Starter, Module, Args, Options) -> E, S ), - init_ack(Starter, {error, {bad_return_value, E}}), + proc_lib:init_ack(Starter, {error, {bad_return_value, E}}), undefined end, case StateT of undefined -> ok; - {State, {continue, Continue}} -> loop(Starter, State, {continue, Continue}); - {State, Timeout} -> loop(Starter, State, Timeout) - end. - -init_ack(Parent, Return) -> - Parent ! {ack, self(), Return}, - ok. - -wait_ack(Pid) when is_pid(Pid) -> - receive - {ack, Pid, Return} -> Return - end; -wait_ack({Pid, _MonRef}) when is_pid(Pid) -> - receive - {ack, Pid, Return} -> Return + #state{} = State -> system_continue(Starter, [], State) end. crash_report(ErrStr, Parent, E, S) -> @@ -269,7 +226,12 @@ crash_report(ErrStr, Parent, E, S) -> Options :: options() ) -> start_ret(). start({local, Name}, Module, Args, Options) when is_atom(Name) -> - spawn_if_not_registered(Name, Module, Args, Options, []). + case erlang:whereis(Name) of + undefined -> + proc_lib:start(?MODULE, init_it, [self(), Name, Module, Args, [{name, Name} | Options]]); + Pid -> + {error, {already_started, Pid}} + end. %%----------------------------------------------------------------------------- %% @param Module the module in which the gen_server callbacks are defined @@ -286,7 +248,7 @@ start({local, Name}, Module, Args, Options) when is_atom(Name) -> -spec start(Module :: module(), Args :: term(), Options :: options()) -> start_ret(). start(Module, Args, Options) -> - do_spawn(Module, Args, Options, []). + proc_lib:start(?MODULE, init_it, [self(), Module, Args, Options]). %%----------------------------------------------------------------------------- %% @param ServerName the name with which to register the gen_server @@ -310,7 +272,14 @@ start(Module, Args, Options) -> Options :: options() ) -> start_ret(). start_link({local, Name}, Module, Args, Options) when is_atom(Name) -> - spawn_if_not_registered(Name, Module, Args, Options, [link]). + case erlang:whereis(Name) of + undefined -> + proc_lib:start_link(?MODULE, init_it, [ + self(), Name, Module, Args, [{name, Name} | Options] + ]); + Pid -> + {error, {already_started, Pid}} + end. %%----------------------------------------------------------------------------- %% @param Module the module in which the gen_server callbacks are defined @@ -327,7 +296,7 @@ start_link({local, Name}, Module, Args, Options) when is_atom(Name) -> -spec start_link(Module :: module(), Args :: term(), Options :: options()) -> start_ret(). start_link(Module, Args, Options) -> - do_spawn(Module, Args, Options, [link]). + proc_lib:start_link(?MODULE, init_it, [self(), Module, Args, Options]). %%----------------------------------------------------------------------------- %% @param Module the module in which the gen_server callbacks are defined @@ -345,7 +314,13 @@ start_link(Module, Args, Options) -> -spec start_monitor(Module :: module(), Args :: term(), Options :: options()) -> start_mon_ret(). start_monitor(Module, Args, Options) -> - do_spawn(Module, Args, Options, [monitor]). + {Result, Monitor} = proc_lib:start_monitor(?MODULE, init_it, [self(), Module, Args, Options]), + case Result of + {ok, Pid} -> + {ok, {Pid, Monitor}}; + _ -> + Result + end. %%----------------------------------------------------------------------------- %% @param ServerName the name with which to register the gen_server @@ -370,7 +345,20 @@ start_monitor(Module, Args, Options) -> Options :: options() ) -> start_mon_ret(). start_monitor({local, Name}, Module, Args, Options) when is_atom(Name) -> - spawn_if_not_registered(Name, Module, Args, Options, [monitor]). + case erlang:whereis(Name) of + undefined -> + {Result, Monitor} = proc_lib:start_monitor(?MODULE, init_it, [ + self(), Name, Module, Args, [{name, Name} | Options] + ]), + case Result of + {ok, Pid} -> + {ok, {Pid, Monitor}}; + _ -> + Result + end; + Pid -> + {error, {already_started, Pid}} + end. %%----------------------------------------------------------------------------- %% @equiv stop(ServerRef, normal, infinity) @@ -434,31 +422,11 @@ call(ServerRef, Request) -> -spec call(ServerRef :: server_ref(), Request :: term(), TimeoutMs :: timeout()) -> Reply :: term() | {error, Reason :: term()}. call(ServerRef, Request, TimeoutMs) -> - MonitorRef = monitor(process, ServerRef), - ok = - try - ServerRef ! {'$gen_call', {self(), MonitorRef}, Request}, - ok - catch - error:badarg -> - % Process no longer exists, monitor will send a message - ok - end, - receive - {'DOWN', MonitorRef, process, _, {E, []} = _Reason} -> - erlang:exit({E, {?MODULE, ?FUNCTION_NAME, [ServerRef, Request]}}); - {'DOWN', MonitorRef, process, _, {_E, _L} = Reason} -> - erlang:exit(Reason); - {'DOWN', MonitorRef, process, _, Atom} when is_atom(Atom) -> - erlang:exit({Atom, {?MODULE, ?FUNCTION_NAME, [ServerRef, Request]}}); - {MonitorRef, Reply} -> - demonitor(MonitorRef, [flush]), - Reply - after TimeoutMs -> - % If TimeoutMS is small enough (0), the error message might be timeout - % instead of noproc as there could be a race condition with the monitor. - demonitor(MonitorRef, [flush]), - erlang:exit({timeout, {?MODULE, ?FUNCTION_NAME, [ServerRef, Request]}}) + try + gen:call(ServerRef, '$gen_call', Request, TimeoutMs) + catch + exit:Reason -> + exit({Reason, {?MODULE, ?FUNCTION_NAME, [ServerRef, Request, TimeoutMs]}}) end. %%----------------------------------------------------------------------------- @@ -473,140 +441,180 @@ call(ServerRef, Request, TimeoutMs) -> %%----------------------------------------------------------------------------- -spec cast(ServerRef :: server_ref(), Request :: term()) -> ok | {error, Reason :: term()}. cast(ServerRef, Request) -> - try - ServerRef ! {'$gen_cast', Request} - catch - error:badarg -> - % Process does not exist, ignore error - ok - end, - ok. + gen:cast(ServerRef, Request). %%----------------------------------------------------------------------------- %% @param From the client to whom to send the reply %% @param Reply the reply to send to the client -%% @returns an arbitrary term, that should be ignored +%% @returns `ok' %% @doc Send a reply to a calling client. %% %% This function will send the specified reply back to the specified -%% gen_server client (e.g, via call/3). The return value of this -%% function can be safely ignored. +%% gen_server client (e.g, via call/3). %% @end %%----------------------------------------------------------------------------- -spec reply(From :: from(), Reply :: term()) -> term(). -reply({Pid, Ref}, Reply) -> - Pid ! {Ref, Reply}, - ok. +reply(From, Reply) -> + gen:reply(From, Reply). %% %% Internal operations %% %% @private -loop(Parent, #state{mod = Mod, mod_state = ModState} = State, {continue, Continue}) -> +system_continue( + Parent, Debug, #state{mod = Mod, mod_state = ModState, timeout = {continue, Continue}} = State +) -> case Mod:handle_continue(Continue, ModState) of {noreply, NewModState} -> - loop(Parent, State#state{mod_state = NewModState}, infinity); + system_continue(Parent, Debug, State#state{mod_state = NewModState, timeout = infinity}); {noreply, NewModState, {continue, NewContinue}} -> - loop(Parent, State#state{mod_state = NewModState}, {continue, NewContinue}); + system_continue(Parent, Debug, State#state{ + mod_state = NewModState, timeout = {continue, NewContinue} + }); {noreply, NewModState, Timeout} -> - loop(Parent, State#state{mod_state = NewModState}, Timeout); + system_continue(Parent, Debug, State#state{mod_state = NewModState, timeout = Timeout}); {stop, Reason, NewModState} -> - do_terminate(State, Reason, NewModState) + system_terminate(Reason, Parent, Debug, State#state{mod_state = NewModState}) end; -loop(Parent, State, {timeout, Timeout, Info}) -> +system_continue(Parent, Debug, #state{timeout = {timeout, Timeout, Info}} = State) -> receive Msg -> - handle_msg(Msg, Parent, State) + handle_msg(Msg, Parent, Debug, State) after Timeout -> - handle_timeout(Parent, Info, State) + handle_timeout(Parent, Info, Debug, State) end; -loop(Parent, State, Timeout) -> +system_continue(Parent, Debug, #state{timeout = Timeout} = State) -> receive Msg -> - handle_msg(Msg, Parent, State) + handle_msg(Msg, Parent, Debug, State) after Timeout -> - handle_timeout(Parent, timeout, State) + handle_timeout(Parent, timeout, Debug, State) end. %% @private -handle_msg(Msg, Parent, #state{mod = Mod, mod_state = ModState} = State) -> +handle_msg(Msg, Parent, Debug, #state{mod = Mod, mod_state = ModState} = State) -> case Msg of + {system, From, Req} -> + sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, State); {'$gen_call', {_Pid, _Ref} = From, Request} -> case Mod:handle_call(Request, From, ModState) of {reply, Reply, NewModState} -> ok = reply(From, Reply), - loop(Parent, State#state{mod_state = NewModState}, infinity); + system_continue(Parent, Debug, State#state{ + mod_state = NewModState, timeout = infinity + }); {reply, Reply, NewModState, {continue, Continue}} -> ok = reply(From, Reply), - loop(Parent, State#state{mod_state = NewModState}, {continue, Continue}); + system_continue(Parent, Debug, State#state{ + mod_state = NewModState, timeout = {continue, Continue} + }); {reply, Reply, NewModState, NewTimeout} -> ok = reply(From, Reply), - loop(Parent, State#state{mod_state = NewModState}, NewTimeout); + system_continue(Parent, Debug, State#state{ + mod_state = NewModState, timeout = NewTimeout + }); {noreply, NewModState} -> - loop(Parent, State#state{mod_state = NewModState}, infinity); + system_continue(Parent, Debug, State#state{ + mod_state = NewModState, timeout = infinity + }); {noreply, NewModState, {continue, Continue}} -> - loop(Parent, State#state{mod_state = NewModState}, {continue, Continue}); + system_continue(Parent, Debug, State#state{ + mod_state = NewModState, timeout = {continue, Continue} + }); {noreply, NewModState, NewTimeout} -> - loop(Parent, State#state{mod_state = NewModState}, NewTimeout); + system_continue(Parent, Debug, State#state{ + mod_state = NewModState, timeout = NewTimeout + }); {stop, Reason, Reply, NewModState} -> ok = reply(From, Reply), - do_terminate(State, Reason, NewModState); + system_terminate(Reason, Parent, Debug, State#state{mod_state = NewModState}); {stop, Reason, NewModState} -> - do_terminate(State, Reason, NewModState); + system_terminate(Reason, Parent, Debug, State#state{mod_state = NewModState}); _ -> - do_terminate(State, {error, unexpected_reply}, ModState) + system_terminate({error, unexpected_reply}, Parent, Debug, State) end; {'$gen_cast', Request} -> case Mod:handle_cast(Request, ModState) of {noreply, NewModState} -> - loop(Parent, State#state{mod_state = NewModState}, infinity); + system_continue(Parent, Debug, State#state{ + mod_state = NewModState, timeout = infinity + }); {noreply, NewModState, {continue, Continue}} -> - loop(Parent, State#state{mod_state = NewModState}, {continue, Continue}); + system_continue(Parent, Debug, State#state{ + mod_state = NewModState, timeout = {continue, Continue} + }); {noreply, NewModState, NewTimeout} -> - loop(Parent, State#state{mod_state = NewModState}, NewTimeout); + system_continue(Parent, Debug, State#state{ + mod_state = NewModState, timeout = NewTimeout + }); {stop, Reason, NewModState} -> - do_terminate(State, Reason, NewModState); + system_terminate(Reason, Parent, Debug, State#state{mod_state = NewModState}); _ -> - do_terminate(State, {error, unexpected_reply}, ModState) + system_terminate({error, unexpected_reply}, Parent, Debug, State) end; {'$stop', Reason} -> - do_terminate(State, Reason, ModState); + system_terminate(Reason, Parent, Debug, State); {'EXIT', Parent, Reason} -> - do_terminate(State, Reason, ModState); + system_terminate(Reason, Parent, Debug, State); Info -> case Mod:handle_info(Info, ModState) of {noreply, NewModState} -> - loop(Parent, State#state{mod_state = NewModState}, infinity); + system_continue(Parent, Debug, State#state{ + mod_state = NewModState, timeout = infinity + }); {noreply, NewModState, NewTimeout} -> - loop(Parent, State#state{mod_state = NewModState}, NewTimeout); + system_continue(Parent, Debug, State#state{ + mod_state = NewModState, timeout = NewTimeout + }); {stop, Reason, NewModState} -> - do_terminate(State, Reason, NewModState); + system_terminate(Reason, Parent, Debug, State#state{mod_state = NewModState}); _ -> - do_terminate(State, {error, unexpected_reply}, ModState) + system_terminate({error, unexpected_reply}, Parent, Debug, State) end end. -handle_timeout(Parent, Msg, #state{mod = Mod, mod_state = ModState} = State) -> +%% @private +handle_timeout(Parent, Msg, Debug, #state{mod = Mod, mod_state = ModState} = State) -> case Mod:handle_info(Msg, ModState) of {noreply, NewModState} -> - loop(Parent, State#state{mod_state = NewModState}, infinity); + system_continue(Parent, Debug, State#state{mod_state = NewModState, timeout = infinity}); {noreply, NewModState, NewTimeout} -> - loop(Parent, State#state{mod_state = NewModState}, NewTimeout); + system_continue(Parent, Debug, State#state{ + mod_state = NewModState, timeout = NewTimeout + }); {stop, Reason, NewModState} -> - do_terminate(State, Reason, NewModState); + system_terminate(Reason, Parent, Debug, State#state{mod_state = NewModState}); _ -> - do_terminate(State, {error, unexpected_reply}, ModState) + system_terminate({error, unexpected_reply}, Parent, Debug, State) end. -do_terminate(#state{mod = Mod} = _State, Reason, ModState) -> +%% @private +system_terminate(Reason, _Parent, _Debug, #state{mod = Mod, mod_state = ModState} = _State) -> case erlang:function_exported(Mod, terminate, 2) of true -> Mod:terminate(Reason, ModState); false -> ok end, - case Reason of - normal -> ok; - Other -> exit(Other) + exit(Reason). + +%% @private +system_code_change( + #state{mod_state = ModState, mod = Module} = State, _ChangeModule, OldVsn, Extra +) -> + case erlang:function_exported(Module, code_change, 3) of + true -> + case catch Module:code_change(OldVsn, ModState, Extra) of + {ok, NewModState} -> + {ok, State#state{mod_state = NewModState}}; + Other -> + Other + end; + false -> + {ok, State} end. + +%% @private +system_get_state(#state{mod_state = ModState}) -> + {ok, ModState}. diff --git a/libs/estdlib/src/gen_statem.erl b/libs/estdlib/src/gen_statem.erl index 539bbfb99e..132cc99e1d 100644 --- a/libs/estdlib/src/gen_statem.erl +++ b/libs/estdlib/src/gen_statem.erl @@ -56,6 +56,7 @@ -type options() :: list({atom(), term()}). -type server_ref() :: atom() | pid(). +-type from() :: {pid(), reference()}. -type action() :: {reply, From :: pid(), Reply :: any()} @@ -209,7 +210,12 @@ call(ServerRef, Request) -> -spec call(ServerRef :: server_ref(), Request :: term(), Timeout :: timeout()) -> Reply :: term() | {error, Reason :: term()}. call(ServerRef, Request, Timeout) -> - gen_server:call(ServerRef, Request, Timeout). + try + gen:call(ServerRef, '$gen_call', Request, Timeout) + catch + exit:Reason -> + exit({Reason, {?MODULE, ?FUNCTION_NAME, [ServerRef, Request]}}) + end. %%----------------------------------------------------------------------------- %% @param ServerRef a reference to the gen_statem acquired via start @@ -223,22 +229,21 @@ call(ServerRef, Request, Timeout) -> %%----------------------------------------------------------------------------- -spec cast(ServerRef :: server_ref(), Request :: term()) -> ok | {error, Reason :: term()}. cast(ServerRef, Request) -> - gen_server:cast(ServerRef, Request). + gen:cast(ServerRef, Request). %%----------------------------------------------------------------------------- %% @param Client the client to whom to send the reply %% @param Reply the reply to send to the client -%% @returns an arbitrary term, that should be ignored +%% @returns `ok' %% @doc Send a reply to a calling client. %% %% This function will send the specified reply back to the specified -%% gen_statem client (e.g, via call/3). The return value of this -%% function can be safely ignored. +%% gen_statem client (e.g, via call/3). %% @end %%----------------------------------------------------------------------------- --spec reply(Client :: pid(), Reply :: term()) -> term(). -reply(Client, Reply) -> - gen_server:reply(Client, Reply). +-spec reply(From :: from(), Reply :: term()) -> ok. +reply(From, Reply) -> + gen:reply(From, Reply). %% %% gen_statem callbacks diff --git a/libs/estdlib/src/proc_lib.erl b/libs/estdlib/src/proc_lib.erl index a483bc22cd..6c055af4fa 100644 --- a/libs/estdlib/src/proc_lib.erl +++ b/libs/estdlib/src/proc_lib.erl @@ -45,6 +45,9 @@ start_link/3, start_link/4, start_link/5, + start_monitor/3, + start_monitor/4, + start_monitor/5, init_ack/1, init_ack/2, @@ -129,7 +132,7 @@ start(Module, Function, Args, Timeout) -> %%----------------------------------------------------------------------------- -spec start(module(), atom(), [any()], timeout(), [start_spawn_option()]) -> any(). start(Module, Function, Args, Timeout, SpawnOpts) -> - start0(Module, Function, Args, Timeout, SpawnOpts, false). + start0(Module, Function, Args, Timeout, SpawnOpts, false, false). %% @equiv start_link(Module, Function, Args, infinity) -spec start_link(module(), atom(), [any()]) -> any(). @@ -153,33 +156,61 @@ start_link(Module, Function, Args, Timeout) -> %%----------------------------------------------------------------------------- -spec start_link(module(), atom(), [any()], timeout(), [start_spawn_option()]) -> any(). start_link(Module, Function, Args, Timeout, SpawnOpts) -> - start0(Module, Function, Args, Timeout, [link | SpawnOpts], true). + start0(Module, Function, Args, Timeout, [link | SpawnOpts], true, false). + +%% @equiv start_monitor(Module, Function, Args, infinity) +-spec start_monitor(module(), atom(), [any()]) -> any(). +start_monitor(Module, Function, Args) -> + start_monitor(Module, Function, Args, infinity). + +%% @equiv start_monitor(Module, Function, Args, Timeout, []) +-spec start_monitor(module(), atom(), [any()], timeout()) -> any(). +start_monitor(Module, Function, Args, Timeout) -> + start_monitor(Module, Function, Args, Timeout, []). + +%%----------------------------------------------------------------------------- +%% @param Module the module in which the callbacks are defined +%% @param Function to call for initialization +%% @param Args arguments to pass to the function +%% @param Timeout timeout for the initialization to be done +%% @param SpawnOpts options passed to spawn_link. `monitor' is not allowed. +%% @doc Start a new process synchronously and atomically link it. +%% Wait for the process to call `init_ack/1,2' or `init_fail/2,3'. +%% @end +%%----------------------------------------------------------------------------- +-spec start_monitor(module(), atom(), [any()], timeout(), [start_spawn_option()]) -> any(). +start_monitor(Module, Function, Args, Timeout, SpawnOpts) -> + start0(Module, Function, Args, Timeout, SpawnOpts, true, true). %% @private -start0(Module, Function, Args, Timeout, SpawnOpts, Link) -> +start0(Module, Function, Args, Timeout, SpawnOpts, Link, Monitor) -> case lists:member(monitor, SpawnOpts) of true -> error(badarg); false -> ok end, Parent = self(), Ancestors = get_ancestors(), - {Pid, Monitor} = spawn_opt(?MODULE, init_p, [Parent, Ancestors, Module, Function, Args], [ + {Pid, MonitorRef} = spawn_opt(?MODULE, init_p, [Parent, Ancestors, Module, Function, Args], [ monitor | SpawnOpts ]), receive + {ack, Pid, Result} when Monitor -> + {Result, MonitorRef}; {ack, Pid, Result} -> - erlang:demonitor(Monitor, [flush]), + erlang:demonitor(MonitorRef, [flush]), Result; - {'DOWN', Monitor, process, Pid, Reason} when Link -> + {'DOWN', MonitorRef, process, Pid, Reason} when Link -> receive {'EXIT', Pid, _} -> ok after 0 -> ok end, receive - {'DOWN', Monitor, process, Pid, _} -> ok + {'DOWN', MonitorRef, process, Pid, _} -> ok end, {error, Reason}; - {'DOWN', Monitor, process, Pid, Reason} -> + {'DOWN', MonitorRef, process, Pid, Reason} when Monitor -> + {{error, Reason}, MonitorRef}; + {'DOWN', MonitorRef, process, Pid, Reason} -> {error, Reason} after Timeout -> if @@ -194,9 +225,14 @@ start0(Module, Function, Args, Timeout, SpawnOpts, Link) -> exit(Pid, kill) end, receive - {'DOWN', Monitor, process, Pid, _} -> ok + {'DOWN', MonitorRef, process, Pid, _} -> ok end, - {error, timeout} + case Monitor of + true -> + {{error, timeout}, MonitorRef}; + false -> + {error, timeout} + end end. %% @private diff --git a/libs/estdlib/src/sys.erl b/libs/estdlib/src/sys.erl new file mode 100644 index 0000000000..cd7b4305b4 --- /dev/null +++ b/libs/estdlib/src/sys.erl @@ -0,0 +1,436 @@ +% +% This file is part of AtomVM. +% +% Copyright 2025 Paul Guyot +% +% Licensed under the Apache License, Version 2.0 (the "License"); +% you may not use this file except in compliance with the License. +% You may obtain a copy of the License at +% +% http://www.apache.org/licenses/LICENSE-2.0 +% +% Unless required by applicable law or agreed to in writing, software +% distributed under the License is distributed on an "AS IS" BASIS, +% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +% See the License for the specific language governing permissions and +% limitations under the License. +% +% SPDX-License-Identifier: Apache-2.0 OR LGPL-2.1-or-later +% + +%%----------------------------------------------------------------------------- +%% @doc An implementation of the Erlang/OTP sys interface. +%% +%% This module implements a strict subset of the Erlang/OTP sys +%% interface. +%%----------------------------------------------------------------------------- + +-module(sys). + +-export([ + change_code/4, + change_code/5, + get_state/1, + get_state/2, + get_status/1, + get_status/2, + replace_state/2, + replace_state/3, + resume/1, + resume/2, + suspend/1, + suspend/2, + terminate/2, + terminate/3, + trace/2, + trace/3 +]). + +-export([ + debug_options/1, + handle_debug/4, + handle_system_msg/6 +]). + +-export_type([dbg_opt/0, debug_option/0, system_event/0]). + +%%----------------------------------------------------------------------------- +%% Types +%%----------------------------------------------------------------------------- + +-type name() :: pid() | atom() | {global, term()} | {via, module(), term()}. +-type system_event() :: any(). +-type format_fun() :: fun((standard_io, Event :: any(), Extra :: system_event()) -> any()). + +-opaque dbg_opt() :: {trace, true}. +-type debug_option() :: trace. + +%%----------------------------------------------------------------------------- +%% Defines +%%----------------------------------------------------------------------------- + +-define(DEFAULT_TIMEOUT, 5000). + +%%----------------------------------------------------------------- +%% Callbacks +%%----------------------------------------------------------------- + +-callback system_code_change(Misc, Module, OldVsn, Extra) -> {ok, NMisc} when + Misc :: term(), + OldVsn :: undefined | term(), + Module :: atom(), + Extra :: term(), + NMisc :: term(). + +-callback system_continue(Parent, Debug, Misc) -> no_return() when + Parent :: pid(), + Debug :: [dbg_opt()], + Misc :: term(). + +-callback system_get_state(Misc) -> {ok, State} when + Misc :: term(), State :: term(). + +-callback system_replace_state(StateFun, Misc) -> {ok, NState, NMisc} when + Misc :: term(), + NState :: term(), + NMisc :: term(), + StateFun :: fun((State :: term()) -> NState). + +-callback system_terminate(Reason, Parent, Debug, Misc) -> no_return() when + Reason :: term(), + Parent :: pid(), + Debug :: [dbg_opt()], + Misc :: term(). + +%%----------------------------------------------------------------------------- +%% Public API +%%----------------------------------------------------------------------------- + +%% @equiv change_code(Name, Module, OldVsn, Extra, 5000) +-spec change_code(Name :: name(), Module :: module(), OldVsn :: undefined | any(), Extra :: any()) -> + ok | {error, any()}. +change_code(Name, Module, OldVsn, Extra) -> + change_code(Name, Module, OldVsn, Extra, ?DEFAULT_TIMEOUT). + +%%----------------------------------------------------------------------------- +%% @param Name process to tell to change code. +%% @param Module callback module that should implement `system_code_change/4'. +%% @param OldVsn old version +%% @param Extra any extra term passed from the update script +%% @param Timeout timeout for the code change +%% @return `ok' or an error tuple +%% @doc Tells the process to change code. +%% @end +%%----------------------------------------------------------------------------- +-spec change_code( + Name :: name(), + Module :: module(), + OldVsn :: undefined | any(), + Extra :: any(), + Timeout :: timeout() +) -> ok | {error, any()}. +change_code(Name, Module, OldVsn, Extra, Timeout) -> + gen:call(Name, system, {change_code, Module, OldVsn, Extra}, Timeout). + +%% @equiv get_state(Name, 5000) +-spec get_state(Name :: name()) -> any(). +get_state(Name) -> + get_state(Name, ?DEFAULT_TIMEOUT). + +%%----------------------------------------------------------------------------- +%% @param Name process to get the state of. +%% @param Timeout timeout for getting the state +%% @return the state or raises an error if an error occurred. +%% @doc Gets the state of the process. This function is only meant for +%% debugging. +%% @end +%%----------------------------------------------------------------------------- +-spec get_state(Name :: name(), timeout()) -> any(). +get_state(Name, Timeout) -> + case gen:call(Name, system, get_state, Timeout) of + {ok, State} -> State; + {error, Reason} -> error(Reason) + end. + +%% @equiv get_state(Name, 5000) +-spec get_status(Name :: name()) -> any(). +get_status(Name) -> + get_status(Name, ?DEFAULT_TIMEOUT). + +%%----------------------------------------------------------------------------- +%% @param Name process to get the status of. +%% @param Timeout timeout for getting the status +%% @return the status or raises an error if an error occurred. +%% @doc Gets the status of the process. This function is only meant for +%% debugging and returns raw state. +%% @end +%%----------------------------------------------------------------------------- +-spec get_status(Name :: name(), Timeout :: timeout()) -> + {status, pid(), {module, module()}, [SItem :: any()]}. +get_status(Name, Timeout) -> + gen:call(Name, system, get_status, Timeout). + +%% @equiv replace_state(Name, StateFun, 5000) +-spec replace_state(Name :: name(), StateFun :: fun((any()) -> any())) -> ok. +replace_state(Name, StateFun) -> + replace_state(Name, StateFun, ?DEFAULT_TIMEOUT). + +%%----------------------------------------------------------------------------- +%% @param Name process to replace the state of. +%% @param Timeout timeout for replacing the state. +%% @return the new state or raises an error if an error occurred. +%% @doc Replaces the state of the process, and returns the new state. This +%% function is only meant for debugging. +%% @end +%%----------------------------------------------------------------------------- +-spec replace_state(Name :: name(), StateFun :: fun((any()) -> any()), Timeout :: timeout()) -> ok. +replace_state(Name, StateFun, Timeout) -> + case gen:call(Name, system, {replace_state, StateFun}, Timeout) of + {ok, State} -> State; + {error, Reason} -> error(Reason) + end. + +%% @equiv resume(Name, 5000) +-spec resume(Name :: name()) -> ok. +resume(Name) -> + resume(Name, ?DEFAULT_TIMEOUT). + +%%----------------------------------------------------------------------------- +%% @param Name process to resume. +%% @param Timeout timeout for resuming the process. +%% @return `ok' or raises an exception if an error occurred. +%% @doc Resume a suspended process. +%% @end +%%----------------------------------------------------------------------------- +-spec resume(Name :: name(), Timeout :: timeout()) -> ok. +resume(Name, Timeout) -> + gen:call(Name, system, resume, Timeout). + +%% @equiv suspend(Name, 5000) +-spec suspend(Name :: name()) -> ok. +suspend(Name) -> + suspend(Name, ?DEFAULT_TIMEOUT). + +%%----------------------------------------------------------------------------- +%% @param Name process to suspend. +%% @param Timeout timeout for suspending the process. +%% @return `ok' or raises an exception if an error occurred. +%% @doc Suspend the process. When a process is suspended, it only responds +%% to other system messages, but not to any other message. +%% @end +%%----------------------------------------------------------------------------- +-spec suspend(Name :: name(), Timeout :: timeout()) -> ok. +suspend(Name, Timeout) -> + gen:call(Name, system, suspend, Timeout). + +%% @equiv terminate(Name, Reason, 5000) +-spec terminate(Name :: name(), Reason :: any()) -> ok. +terminate(Name, Reason) -> + terminate(Name, Reason, ?DEFAULT_TIMEOUT). + +%%----------------------------------------------------------------------------- +%% @param Name process to terminate +%% @param Reason reason for termination +%% @param Timeout timeout for terminating +%% @return `ok' or raises an exception if an error occurred. +%% @doc Terminate a process +%% @end +%%----------------------------------------------------------------------------- +-spec terminate(Name :: name(), Reason :: any(), Timeout :: timeout()) -> ok. +terminate(Name, Reason, Timeout) -> + gen:call(Name, system, {terminate, Reason}, Timeout). + +%% @equiv trace(Name, Flag, 5000) +-spec trace(Name :: name(), Flag :: boolean()) -> ok. +trace(Name, Flag) -> + trace(Name, Flag, ?DEFAULT_TIMEOUT). + +%%----------------------------------------------------------------------------- +%% @param Name process to change trace of. +%% @param Flag whether to enable tracing or to disable it. +%% @param Timeout timeout for changing trace state. +%% @return `ok' or raises an exception if an error occurred. +%% @doc Enable or disable trace on a process. +%% @end +%%----------------------------------------------------------------------------- +-spec trace(Name :: name(), Flag :: boolean(), Timeout :: timeout()) -> ok. +trace(Name, Flag, Timeout) -> + gen:call(Name, system, {debug, {trace, Flag}}, Timeout). + +%%----------------------------------------------------------------------------- +%% Process Implementation Functions +%%----------------------------------------------------------------------------- + +%%----------------------------------------------------------------------------- +%% @group Process Implementation Functions +%% @param Opt debug options. +%% @return opaque debug options to be passed to handlers. +%% @doc Initiates debug structure with a list of options. The only supported +%% option is `trace'. +%% @end +%%----------------------------------------------------------------------------- +-spec debug_options([Opt :: debug_option()]) -> [dbg_opt()]. +debug_options([]) -> + []; +debug_options([trace]) -> + [{trace, true}]. + +%%----------------------------------------------------------------------------- +%% @group Process Implementation Functions +%% @param Debug debug options. +%% @param FormFunc formatting function. +%% @param Extra extra parameter passed to formatting function. +%% @param Event current system event +%% @return new debug optinons +%% @doc Call FormatFunc if tracing is enabled +%% @end +%%----------------------------------------------------------------------------- +-spec handle_debug( + Debug :: [dbg_opt()], FormFunc :: format_fun(), Extra :: any(), Event :: system_event() +) -> [dbg_opt()]. +handle_debug([{trace, true}] = DbgOpts, FormFunc, State, Event) -> + FormFunc(standard_io, Event, State), + DbgOpts; +handle_debug([], _FormFunc, _State, _Event) -> + []. + +%%----------------------------------------------------------------------------- +%% @group Process Implementation Functions +%% @param Opt debug options. +%% @return opaque debug options to be passed to handlers. +%% @doc This function is used by a process module to take care of system +%% messages. The process receives a `{system, From, Msg}' message and passes +%% `Msg' and `From' to this function. +%% This function is meant to be tail-called and will call either: +%% - `Module:system_continue/3' +%% - `Module:system_terminate/4' +%% @end +%%----------------------------------------------------------------------------- +-spec handle_system_msg( + Msg :: any(), + From :: {pid(), any()}, + Parent :: pid(), + Module :: module(), + Debug :: [dbg_opt()], + Misc :: any() +) -> no_return(). +handle_system_msg(Msg, From, Parent, Module, Debug, Misc) -> + handle_system_msg(running, Msg, From, Parent, Module, Debug, Misc). + +%% @private +handle_system_msg(SysState, Msg, From, Parent, Module, Debug0, Misc0) -> + case do_handle_system_msg(SysState, Msg, Parent, Module, Debug0, Misc0) of + {suspended, Reply, Debug1, Misc1} -> + _ = gen:reply(From, Reply), + suspend_loop(suspended, Parent, Module, Debug1, Misc1); + {running, Reply, Debug1, Misc1} -> + _ = gen:reply(From, Reply), + Module:system_continue(Parent, Debug1, Misc1); + {{terminating, Reason}, Reply, Debug1, Misc1} -> + _ = gen:reply(From, Reply), + Module:system_terminate(Reason, Parent, Debug1, Misc1) + end. + +%% @private +do_handle_system_msg(_SysState, suspend, _Parent, _Mod, Debug, Misc) -> + {suspended, ok, Debug, Misc}; +do_handle_system_msg(_SysState, resume, _Parent, _Mod, Debug, Misc) -> + {running, ok, Debug, Misc}; +do_handle_system_msg(SysState, get_state, _Parent, Mod, Debug, Misc) -> + Result = do_get_state(Mod, Misc), + {SysState, Result, Debug, Misc}; +do_handle_system_msg(SysState, {replace_state, StateFun}, _Parent, Mod, Debug, Misc0) -> + {Result, Misc1} = do_replace_state(StateFun, Mod, Misc0), + {SysState, Result, Debug, Misc1}; +do_handle_system_msg(SysState, get_status, Parent, Mod, Debug, Misc) -> + Res = do_get_status(SysState, Parent, Mod, Debug, Misc), + {SysState, Res, Debug, Misc}; +do_handle_system_msg(SysState, {debug, DebugOpt}, _Parent, _Mod, Debug0, Misc) -> + {Result, Debug1} = do_debug(DebugOpt, Debug0), + {SysState, Result, Debug1, Misc}; +do_handle_system_msg(_, {terminate, Reason}, _Parent, _Mod, Debug, Misc) -> + {{terminating, Reason}, ok, Debug, Misc}; +do_handle_system_msg( + suspended, + {change_code, Module, Vsn, Extra}, + _Parent, + Mod, + Debug, + Misc0 +) -> + {Result, Misc1} = do_change_code(Mod, Module, Vsn, Extra, Misc0), + {suspended, Result, Debug, Misc1}; +do_handle_system_msg(SysState, Other, _Parent, _Mod, Debug, Misc) -> + {SysState, {error, {unknown_system_msg, Other}}, Debug, Misc}. + +%% @private +suspend_loop(SysState, Parent, Mod, Debug, Misc) -> + receive + {system, From, Msg} -> + handle_system_msg(SysState, Msg, From, Parent, Mod, Debug, Misc); + {'EXIT', Parent, Reason} -> + Mod:system_terminate(Reason, Parent, Debug, Misc) + end. + +%% @private +do_get_state(Mod, Misc) -> + case erlang:function_exported(Mod, system_get_state, 1) of + true -> + try Mod:system_get_state(Misc) of + {ok, _} = Result -> Result; + Other -> {error, {callback_failed, {Mod, system_get_state}, {bad_return, Other}}} + catch + Class:Exc -> + {error, {callback_failed, {Mod, system_get_state}, {Class, Exc}}} + end; + false -> + {ok, Misc} + end. + +%% @private +do_replace_state(StateFun, Mod, Misc0) -> + case erlang:function_exported(Mod, system_replace_state, 1) of + true -> + try Mod:system_replace_state(StateFun, Misc0) of + {ok, State, Misc1} -> + {{ok, State}, Misc1}; + Other -> + { + {error, + {callback_failed, {Mod, system_replace_state}, {bad_return, Other}}}, + Misc0 + } + catch + Class:Exc -> + {{error, {callback_failed, {Mod, system_replace_state}, {Class, Exc}}}, Misc0} + end; + false -> + try + Misc1 = StateFun(Misc0), + {{ok, Misc1}, Misc1} + catch + Class:Exc -> + {{error, {callback_failed, StateFun, {Class, Exc}}}, Misc0} + end + end. + +%% @private +do_get_status(SysState, Parent, Mod, Debug, Misc) -> + ProcessDictionary = get(), + {status, self(), {module, Mod}, [ProcessDictionary, SysState, Parent, Debug, Misc]}. + +%% @private +do_debug({trace, true} = Tuple, Debug0) -> + Debug1 = lists:keystore(trace, 1, Debug0, Tuple), + {ok, Debug1}; +do_debug({trace, false}, Debug0) -> + Debug1 = lists:keydelete(trace, 1, Debug0), + {ok, Debug1}; +do_debug(_Other, Debug0) -> + {unknown_debug, Debug0}. + +do_change_code(Mod, Module, Vsn, Extra, Misc0) -> + case catch Mod:system_code_change(Misc0, Module, Vsn, Extra) of + {ok, Misc1} -> {ok, Misc1}; + Other -> {{error, Other}, Misc0} + end. diff --git a/tests/libs/estdlib/CMakeLists.txt b/tests/libs/estdlib/CMakeLists.txt index c50dec88f3..039f5ec069 100644 --- a/tests/libs/estdlib/CMakeLists.txt +++ b/tests/libs/estdlib/CMakeLists.txt @@ -45,6 +45,7 @@ set(ERLANG_MODULES test_spawn test_ssl test_string + test_sys test_proplists test_queue test_timer diff --git a/tests/libs/estdlib/test_gen_server.erl b/tests/libs/estdlib/test_gen_server.erl index ac8792f372..64454ae8d9 100644 --- a/tests/libs/estdlib/test_gen_server.erl +++ b/tests/libs/estdlib/test_gen_server.erl @@ -21,7 +21,15 @@ -module(test_gen_server). -export([test/0]). --export([init/1, handle_continue/2, handle_call/3, handle_cast/2, handle_info/2, terminate/2]). +-export([ + init/1, + handle_continue/2, + handle_call/3, + handle_cast/2, + handle_info/2, + code_change/3, + terminate/2 +]). -record(state, { num_casts = 0, @@ -37,6 +45,7 @@ test() -> ok = test_info(), ok = test_start_link(), ok = test_start_monitor(), + ok = test_start_name(), ok = test_continue(), ok = test_init_exception(), ok = test_late_reply(), @@ -54,6 +63,9 @@ test() -> ok = test_crash_in_terminate(), ok = test_call_noproc(), ok = test_stop_noproc(), + ok = test_sys_get_state_status(), + ok = test_sys_suspend_resume(), + ok = test_sys_change_code(), ok. test_call() -> @@ -71,19 +83,20 @@ test_start_link() -> pong = gen_server:call(Pid, ping), pong = gen_server:call(Pid, reply_ping), - false = erlang:process_flag(trap_exit, true), + PreviousTrapExit = erlang:process_flag(trap_exit, true), ok = gen_server:cast(Pid, crash), ok = receive {'EXIT', Pid, _Reason} -> ok after 30000 -> timeout end, - true = erlang:process_flag(trap_exit, false), + true = erlang:process_flag(trap_exit, PreviousTrapExit), ok. test_start_monitor() -> case get_otp_version() of - Version when Version =:= atomvm orelse (is_integer(Version) andalso Version >= 23) -> + %% Test on AtomVM and OTP 23 and later + Version when Version >= 23 -> {ok, {Pid, Ref}} = gen_server:start_monitor(?MODULE, [], []), pong = gen_server:call(Pid, ping), @@ -99,6 +112,32 @@ test_start_monitor() -> ok end. +test_start_name() -> + undefined = whereis(?MODULE), + {ok, Pid1} = gen_server:start({local, ?MODULE}, ?MODULE, [], []), + Pid1 = whereis(?MODULE), + ok = gen_server:stop(Pid1), + undefined = whereis(?MODULE), + + {ok, Pid2} = gen_server:start_link({local, ?MODULE}, ?MODULE, [], []), + Pid2 = whereis(?MODULE), + ok = gen_server:stop(Pid2), + undefined = whereis(?MODULE), + + case get_otp_version() of + %% Test on AtomVM and OTP 23 and later + Version when Version >= 23 -> + {ok, {Pid3, MonitorRef}} = gen_server:start_monitor({local, ?MODULE}, ?MODULE, [], []), + Pid3 = whereis(?MODULE), + % Demonitor to avoid any DOWN message + true = demonitor(MonitorRef), + ok = gen_server:stop(Pid3), + undefined = whereis(?MODULE); + _ -> + ok + end, + ok. + test_continue() -> {ok, Pid} = gen_server:start_link(?MODULE, {continue, self()}, []), [{Pid, continue}, {Pid, after_continue}] = read_replies(Pid), @@ -487,6 +526,44 @@ test_stop_noproc() -> ok end. +test_sys_get_state_status() -> + {ok, Pid} = gen_server:start(?MODULE, [], []), + #state{} = sys:get_state(Pid), + {status, Pid, {module, gen_server}, _Extra} = sys:get_status(Pid), + ok = gen_server:stop(Pid), + ok. + +test_sys_suspend_resume() -> + {ok, Pid} = gen_server:start(?MODULE, [], []), + ok = sys:suspend(Pid), + ok = + try + gen_server:call(Pid, ping, 500), + unexpected + catch + exit:{timeout, {gen_server, call, [Pid, ping, 500]}} -> ok + end, + ok = sys:resume(Pid), + pong = gen_server:call(Pid, ping, 500), + ok = gen_server:stop(Pid), + ok. + +test_sys_change_code() -> + {ok, Pid} = gen_server:start(?MODULE, [], []), + ok = gen_server:cast(Pid, ping), + 1 = gen_server:call(Pid, get_num_casts), + ok = sys:suspend(Pid), + ok = sys:change_code(Pid, ?MODULE, "old_vsn", {extra, self()}), + ok = + receive + {Pid, updated, "old_vsn"} -> ok + after 500 -> timeout + end, + ok = sys:resume(Pid), + 0 = gen_server:call(Pid, get_num_casts), + ok = gen_server:stop(Pid), + ok. + get_otp_version() -> case erlang:system_info(machine) of "BEAM" -> @@ -641,6 +718,10 @@ handle_info(_Info, #state{info_timeout = InfoTimeout} = State) -> {noreply, State, Other} end. +code_change(OldVsn, State, {extra, Pid}) -> + Pid ! {self(), updated, OldVsn}, + {ok, State#state{num_casts = 0}}. + terminate(_Reason, #state{crash_in_terminate = true} = _State) -> error(crash_in_terminate); terminate(_Reason, _State) -> diff --git a/tests/libs/estdlib/test_proc_lib.erl b/tests/libs/estdlib/test_proc_lib.erl index bb317374c2..2c783d1960 100644 --- a/tests/libs/estdlib/test_proc_lib.erl +++ b/tests/libs/estdlib/test_proc_lib.erl @@ -28,6 +28,12 @@ test() -> ok = test_start_monitor_badarg(), ok = test_start_link_sync(), ok = test_start_link_opt_sync(), + case get_otp_version() of + Version when Version >= 23 -> + ok = test_start_monitor_sync(); + _ -> + ok + end, ok = test_start_timeout(), ok = test_start_crash(), ok = test_initial_call_and_ancestors(), @@ -45,7 +51,7 @@ test_start_sync() -> end, true = is_process_alive(Pid), {links, []} = process_info(Pid, links), - exit(Pid, normal), + exit(Pid, kill), ok. test_start_monitor_badarg() -> @@ -72,7 +78,7 @@ test_start_link_sync() -> true = is_process_alive(Pid), {links, [Parent]} = process_info(Pid, links), unlink(Pid), - exit(Pid, normal), + exit(Pid, kill), ok. test_start_link_opt_sync() -> @@ -87,7 +93,27 @@ test_start_link_opt_sync() -> true = is_process_alive(Pid), {links, [Parent]} = process_info(Pid, links), unlink(Pid), - exit(Pid, normal), + exit(Pid, kill), + ok. + +test_start_monitor_sync() -> + Parent = self(), + {Ret, Monitor} = proc_lib:start_monitor(?MODULE, init_ok, [Parent]), + ok = Ret, + true = is_reference(Monitor), + {ok, Pid} = + receive + {Process, inited} -> {ok, Process} + after 0 -> fail + end, + true = is_process_alive(Pid), + {links, []} = process_info(Pid, links), + exit(Pid, kill), + killed = + receive + {'DOWN', Monitor, process, Pid, Reason} -> Reason + after 500 -> timeout + end, ok. test_start_timeout() -> @@ -242,3 +268,11 @@ init_crash({Class, Reason, Stacktrace}) -> init_initial_call_ancestors(Parent) -> proc_lib:init_ack(Parent, {ok, get('$initial_call'), get('$ancestors')}). + +get_otp_version() -> + case erlang:system_info(machine) of + "BEAM" -> + list_to_integer(erlang:system_info(otp_release)); + _ -> + atomvm + end. diff --git a/tests/libs/estdlib/test_sys.erl b/tests/libs/estdlib/test_sys.erl new file mode 100644 index 0000000000..dbffaa6516 --- /dev/null +++ b/tests/libs/estdlib/test_sys.erl @@ -0,0 +1,192 @@ +% +% This file is part of AtomVM. +% +% Copyright 2025 Paul Guyot +% +% Licensed under the Apache License, Version 2.0 (the "License"); +% you may not use this file except in compliance with the License. +% You may obtain a copy of the License at +% +% http://www.apache.org/licenses/LICENSE-2.0 +% +% Unless required by applicable law or agreed to in writing, software +% distributed under the License is distributed on an "AS IS" BASIS, +% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +% See the License for the specific language governing permissions and +% limitations under the License. +% +% SPDX-License-Identifier: Apache-2.0 OR LGPL-2.1-or-later +% + +-module(test_sys). + +-export([test/0, system_continue/3, system_terminate/4, system_code_change/4]). +-export([start/0]). + +start() -> + ok = test(). + +test() -> + ok = test_get_state_status(), + ok = test_replace_state(), + ok = test_suspend_resume(), + ok = test_change_code(), + ok = test_trace(), + ok. + +test_get_state_status() -> + Parent = self(), + {SysPid, MonitorRef} = spawn_opt(fun() -> system_continue(Parent, [], state) end, [ + link, monitor + ]), + state = sys:get_state(SysPid), + {status, SysPid, {module, ?MODULE}, _Extra} = sys:get_status(SysPid), + ok = sys:terminate(SysPid, normal), + normal = + receive + {'DOWN', MonitorRef, process, SysPid, Reason} -> Reason + after 1000 -> timeout + end, + ok. + +test_replace_state() -> + Parent = self(), + {SysPid, MonitorRef} = spawn_opt(fun() -> system_continue(Parent, [], {state, 0}) end, [ + link, monitor + ]), + {state, 1} = sys:replace_state(SysPid, fun({state, 0}) -> {state, 1} end), + {state, 1} = sys:get_state(SysPid), + ok = + try + sys:replace_state(SysPid, fun({state, 0}) -> {state, 1} end), + unexpected + catch + error:{callback_failed, _, {error, function_clause}} -> ok + end, + ok = sys:terminate(SysPid, normal), + normal = + receive + {'DOWN', MonitorRef, process, SysPid, Reason} -> Reason + after 1000 -> timeout + end, + ok. + +test_suspend_resume() -> + Parent = self(), + {SysPid, MonitorRef} = spawn_opt(fun() -> system_continue(Parent, [], {state, 0}) end, [ + link, monitor + ]), + SysPid ! {test_sys_ping, self()}, + ok = + receive + {SysPid, pong} -> ok + after 1000 -> timeout + end, + ok = sys:suspend(SysPid), + SysPid ! {test_sys_ping, self()}, + ok = + receive + {SysPid, pong} -> unexpected + after 500 -> ok + end, + ok = sys:resume(SysPid), + ok = + receive + {SysPid, pong} -> ok + after 1000 -> timeout + end, + ok = sys:terminate(SysPid, normal), + normal = + receive + {'DOWN', MonitorRef, process, SysPid, Reason} -> Reason + after 1000 -> timeout + end, + ok. + +test_change_code() -> + Parent = self(), + {SysPid, MonitorRef} = spawn_opt(fun() -> system_continue(Parent, [], state) end, [ + link, monitor + ]), + state = sys:get_state(SysPid), + ok = sys:suspend(SysPid), + ok = sys:change_code(SysPid, module, "1", extra), + ok = sys:resume(SysPid), + {state, module, "1", extra} = sys:get_state(SysPid), + ok = sys:terminate(SysPid, normal), + normal = + receive + {'DOWN', MonitorRef, process, SysPid, Reason} -> Reason + after 1000 -> timeout + end, + ok. + +test_trace() -> + Parent = self(), + {SysPid, MonitorRef} = spawn_opt(fun() -> system_continue(Parent, [], state) end, [ + link, monitor + ]), + state = sys:get_state(SysPid), + ok = + receive + {debug_event, SysPid, _, _, _} = Msg -> {unexpected, Msg} + after 100 -> ok + end, + ok = sys:trace(SysPid, true), + state = sys:get_state(SysPid), + ok = + receive + {debug_event, SysPid, standard_io, get_state, state} -> ok + after 500 -> timeout + end, + ok = sys:trace(SysPid, false), + ok = + receive + {debug_event, SysPid, standard_io, {debug, {trace, false}}, state} -> ok + after 500 -> timeout + end, + state = sys:get_state(SysPid), + ok = + receive + {debug_event, SysPid, _, _, _} = Msg3 -> {unexpected, Msg3} + after 100 -> ok + end, + ok = sys:terminate(SysPid, normal), + normal = + receive + {'DOWN', MonitorRef, process, SysPid, Reason} -> Reason + after 1000 -> timeout + end, + ok. + +system_continue(Parent, Debug, State) -> + receive + {system, From, Msg} -> + sys:handle_debug( + Debug, + fun(Dev, Event, EventState) -> format_event(Parent, Dev, Event, EventState) end, + State, + Msg + ), + sys:handle_system_msg(Msg, From, Parent, ?MODULE, Debug, State); + {test_sys_ping, Pid} -> + Pid ! {self(), pong}, + system_continue(Parent, Debug, State); + Other -> + sys:handle_debug( + Debug, + fun(Dev, Event, EventState) -> format_event(Parent, Dev, Event, EventState) end, + State, + {unexpected, Other} + ), + system_continue(Parent, Debug, State) + end. + +system_terminate(Reason, _Parent, _Debug, _State) -> + exit(Reason). + +system_code_change(State, Module, Vsn, Extra) -> + {ok, {State, Module, Vsn, Extra}}. + +format_event(Parent, Dev, Event, State) -> + Parent ! {debug_event, self(), Dev, Event, State}.