File 0514-debugger-Add-specs-to-public-functions.patch of Package erlang
From 89a4bfc90828f75eb7957cf99321f32a82209801 Mon Sep 17 00:00:00 2001
From: Lukas Larsson <lukas@erlang.org>
Date: Mon, 9 Oct 2023 15:42:30 +0200
Subject: [PATCH] debugger: Add specs to public functions
---
lib/debugger/src/dbg_wx_break.erl | 4 +-
lib/debugger/src/dbg_wx_mon.erl | 4 +-
lib/debugger/src/dbg_wx_trace.erl | 14 ++--
lib/debugger/src/dbg_wx_view.erl | 14 ++--
lib/debugger/src/debugger.erl | 9 +++
lib/debugger/src/i.erl | 78 +++++++++++++++++++
lib/debugger/src/int.erl | 121 ++++++++++++++++++++++++++++++
7 files changed, 226 insertions(+), 18 deletions(-)
diff --git a/lib/debugger/src/dbg_wx_break.erl b/lib/debugger/src/dbg_wx_break.erl
index 764322d7c4..40d784474a 100644
--- a/lib/debugger/src/dbg_wx_break.erl
+++ b/lib/debugger/src/dbg_wx_break.erl
@@ -89,10 +89,10 @@ gui_cmd({break, DataL, Action}, _Win) ->
fun(Data) ->
case Data of
[Mod, Line] ->
- int:break(Mod, Line),
+ _ = int:break(Mod, Line),
int:action_at_break(Mod, Line, Action);
[Mod, Line, CMod, CFunc] ->
- int:break(Mod, Line),
+ _ = int:break(Mod, Line),
int:test_at_break(Mod, Line, {CMod, CFunc}),
int:action_at_break(Mod, Line, Action);
[Mod, Func, Arity] ->
diff --git a/lib/debugger/src/dbg_wx_mon.erl b/lib/debugger/src/dbg_wx_mon.erl
index 88f3cab4db..c46a97599f 100644
--- a/lib/debugger/src/dbg_wx_mon.erl
+++ b/lib/debugger/src/dbg_wx_mon.erl
@@ -355,7 +355,7 @@ gui_cmd('Next', State) ->
int:next((State#state.focus)#pinfo.pid),
State;
gui_cmd('Continue', State) ->
- int:continue((State#state.focus)#pinfo.pid),
+ _ = int:continue((State#state.focus)#pinfo.pid),
State;
gui_cmd('Finish ', State) ->
int:finish((State#state.focus)#pinfo.pid),
@@ -714,7 +714,7 @@ load_settings2(Settings, State) ->
lists:foreach(fun(Break) ->
{{Mod, Line}, [Status, Action, _, Cond]} =
Break,
- int:break(Mod, Line),
+ _ = int:break(Mod, Line),
if
Status =:= inactive ->
int:disable_break(Mod, Line);
diff --git a/lib/debugger/src/dbg_wx_trace.erl b/lib/debugger/src/dbg_wx_trace.erl
index 931d02a5b1..3aa335cd3b 100644
--- a/lib/debugger/src/dbg_wx_trace.erl
+++ b/lib/debugger/src/dbg_wx_trace.erl
@@ -442,13 +442,13 @@ gui_cmd('Delete All', State) ->
int:no_break(State#state.cm),
State;
gui_cmd({break, {Mod, Line}, What}, State) ->
- case What of
- add -> int:break(Mod, Line);
- delete -> int:delete_break(Mod, Line);
- {status, inactive} -> int:disable_break(Mod, Line);
- {status, active} -> int:enable_break(Mod, Line);
- {trigger, Action} -> int:action_at_break(Mod, Line, Action)
- end,
+ _ = case What of
+ add -> int:break(Mod, Line);
+ delete -> int:delete_break(Mod, Line);
+ {status, inactive} -> int:disable_break(Mod, Line);
+ {status, active} -> int:enable_break(Mod, Line);
+ {trigger, Action} -> int:action_at_break(Mod, Line, Action)
+ end,
State;
%% Options menu
diff --git a/lib/debugger/src/dbg_wx_view.erl b/lib/debugger/src/dbg_wx_view.erl
index 6ed1f19c31..4d227290c8 100644
--- a/lib/debugger/src/dbg_wx_view.erl
+++ b/lib/debugger/src/dbg_wx_view.erl
@@ -190,13 +190,13 @@ gui_cmd('Delete All', State) ->
int:no_break(State#state.mod),
State;
gui_cmd({break, {Mod, Line}, What}, State) ->
- case What of
- add -> int:break(Mod, Line);
- delete -> int:delete_break(Mod, Line);
- {status, inactive} -> int:disable_break(Mod, Line);
- {status, active} -> int:enable_break(Mod, Line);
- {trigger, Action} -> int:action_at_break(Mod, Line, Action)
- end,
+ _ = case What of
+ add -> int:break(Mod, Line);
+ delete -> int:delete_break(Mod, Line);
+ {status, inactive} -> int:disable_break(Mod, Line);
+ {status, active} -> int:enable_break(Mod, Line);
+ {trigger, Action} -> int:action_at_break(Mod, Line, Action)
+ end,
State;
%% Help menu
diff --git a/lib/debugger/src/debugger.erl b/lib/debugger/src/debugger.erl
index f92c8e4a23..dc45dfc047 100644
--- a/lib/debugger/src/debugger.erl
+++ b/lib/debugger/src/debugger.erl
@@ -69,8 +69,11 @@
%% GUI specific functionality used by more than one window type.
%%
%%====================================================================
+-spec start() -> term().
start() ->
start(global, default, default).
+-spec start(Mode) -> term() when Mode :: local | global | wx;
+ (File) -> term() when File :: string().
start(Mode) when Mode==local; Mode==global ->
start(Mode, default, default);
start(Gui) when Gui==wx ->
@@ -78,6 +81,8 @@ start(Gui) when Gui==wx ->
start(SFile) when is_list(SFile), is_integer(hd(SFile)) ->
start(global, SFile, default).
+-spec start(Mode, File) -> term() when Mode :: local | global,
+ File :: string().
start(Mode, SFile) ->
start(Mode, SFile, default).
@@ -90,6 +95,9 @@ start(Mode, SFile, default) ->
stop() ->
dbg_wx_mon:stop().
+-spec quick(Module, Name, Args) -> term() when Module :: atom(),
+ Name :: atom(),
+ Args :: [term()].
quick(M, F, A) ->
int:i(M),
auto_attach([init]),
@@ -101,3 +109,4 @@ auto_attach(Flags) ->
end.
which_gui() -> wx.
+
diff --git a/lib/debugger/src/i.erl b/lib/debugger/src/i.erl
index 5bab31cc4a..165d4ba77e 100644
--- a/lib/debugger/src/i.erl
+++ b/lib/debugger/src/i.erl
@@ -29,6 +29,7 @@
-import(io, [format/1,format/2]).
-import(lists, [sort/1,foreach/2]).
+-spec iv() -> atom().
iv() ->
Vsn = string:slice(filename:basename(code:lib_dir(debugger)), 9),
list_to_atom(Vsn).
@@ -39,6 +40,7 @@ iv() ->
%% running interpreted modules.
%% -------------------------------------------
+-spec im() -> pid().
im() ->
case debugger:start() of
{ok, Pid} ->
@@ -54,6 +56,15 @@ im() ->
%% Module(s) can be given with absolute path.
%% -------------------------------------------
+-spec ii(AbsModule) -> {module, Module} | error when
+ AbsModule :: Module | File,
+ Module :: module(),
+ File :: file:name_all();
+ (AbsModules) -> ok when
+ AbsModules :: [AbsModule],
+ AbsModule :: Module | File,
+ Module :: module(),
+ File :: file:name_all().
ii(Module) ->
int:i(Module).
@@ -65,6 +76,10 @@ ii(Module,_Options) ->
%% removed from the set of modules interpreted.
%% -------------------------------------------
+-spec iq(AbsModule) -> ok when
+ AbsModule :: Module | File,
+ Module :: module(),
+ File :: file:name_all().
iq(Module) ->
int:n(Module).
@@ -74,12 +89,24 @@ iq(Module) ->
%% at all nodes using the broadcast facility.
%% -------------------------------------------
+-spec ini(AbsModules) -> ok when
+ AbsModules :: [AbsModule],
+ AbsModule :: Module | File,
+ Module :: module(),
+ File :: file:name_all();
+ (AbsModule) -> {module, Module} | error when
+ AbsModule :: Module | File,
+ Module :: module(),
+ File :: file:name_all().
ini(Module) ->
int:ni(Module).
ini(Module,_Options) ->
int:ni(Module).
+-spec inq(AbsModule) -> ok when AbsModule :: Module | File,
+ Module :: module(),
+ File :: file:name_all().
inq(Module) ->
int:nn(Module).
@@ -87,6 +114,8 @@ inq(Module) ->
%% Add a new break point at Line in Module.
%% -------------------------------------------
+-spec ib(Module, Line) -> ok | {error, break_exists}
+ when Module :: module(), Line :: integer().
ib(Module,Line) ->
int:break(Module,Line).
@@ -96,6 +125,8 @@ ib(Module,Line) ->
%% all function clauses.
%% -------------------------------------------
+-spec ib(Module, Name, Arity) -> ok | {error, function_not_found}
+ when Module :: module(), Name :: atom(), Arity :: integer().
ib(Module,Function,Arity) ->
int:break_in(Module,Function,Arity).
@@ -117,6 +148,7 @@ ib(Module,Function,Arity,Cond) ->
%% Make an existing break point inactive.
%% -------------------------------------------
+-spec ibd(Module, Line) -> ok when Module :: module(), Line :: integer().
ibd(Mod,Line) ->
int:disable_break(Mod,Line).
@@ -124,6 +156,7 @@ ibd(Mod,Line) ->
%% Make an existing break point active.
%% -------------------------------------------
+-spec ibe(Module, Line) -> ok when Module :: module(), Line :: integer().
ibe(Mod,Line) ->
int:enable_break(Mod,Line).
@@ -133,6 +166,11 @@ ibe(Mod,Line) ->
%% Action is: enable, disable or delete.
%% -------------------------------------------
+-spec iba(Module, Line, Action) -> ok
+ when
+ Module :: module(),
+ Line :: integer(),
+ Action :: enable | disable | delete.
iba(Mod,Line,Action) ->
int:action_at_break(Mod,Line,Action).
@@ -149,6 +187,11 @@ iba(Mod,Line,Action) ->
%% Fnk == {Module,Function,ExtraArgs}
%% -------------------------------------------
+-spec ibc(Module, Line, Function) -> ok when
+ Module :: module(),
+ Line :: integer(),
+ Function :: {Module, Name},
+ Name :: atom().
ibc(Mod,Line,Fnk) ->
int:test_at_break(Mod,Line,Fnk).
@@ -156,6 +199,7 @@ ibc(Mod,Line,Fnk) ->
%% Delete break point.
%% -------------------------------------------
+-spec ir(Module, Line) -> ok when Module :: module(), Line :: integer().
ir(Module,Line) ->
int:delete_break(Module,Line).
@@ -163,6 +207,8 @@ ir(Module,Line) ->
%% Delete break at entrance of specified function.
%% -------------------------------------------
+-spec ir(Module, Name, Arity) -> ok | {error, function_not_found}
+ when Module :: module(), Name :: atom(), Arity :: integer().
ir(Module,Function,Arity) ->
int:del_break_in(Module,Function,Arity).
@@ -170,6 +216,7 @@ ir(Module,Function,Arity) ->
%% Delete all break points in module.
%% -------------------------------------------
+-spec ir(Module) -> ok when Module :: module().
ir(Module) ->
int:no_break(Module).
@@ -177,6 +224,7 @@ ir(Module) ->
%% Delete all break points (for all modules).
%% -------------------------------------------
+-spec ir() -> ok.
ir() ->
int:no_break().
@@ -184,6 +232,7 @@ ir() ->
%% Print all interpreted modules.
%% -------------------------------------------
+-spec il() -> ok.
il() ->
Mods = sort(int:interpreted()),
ilformat("Module","File"),
@@ -204,11 +253,13 @@ ilformat(A1, A2) ->
%% Print all break points in modules.
%% -------------------------------------------
+-spec ipb() -> ok.
ipb() ->
Bps = lists:keysort(1,int:all_breaks()),
bhformat("Module","Line","Status","Action","Condition"),
pb_print(Bps).
+-spec ipb(Module) -> ok when Module :: module().
ipb(Module) when is_atom(Module) ->
ipb1(Module);
ipb(Module) when is_list(Module) ->
@@ -240,6 +291,7 @@ bformat(A1, A2, A3, A4, A5) ->
%% Flag can be all (true), no_tail or false.
%% -------------------------------------------
+-spec ist(Flag) -> true when Flag :: all | no_tail | false.
ist(Flag) ->
int:stack_trace(Flag),
true.
@@ -250,6 +302,7 @@ ist(Flag) ->
%% iaa(Flag) or ia([Flag,Flag,...])
%% -------------------------------------------
+-spec iaa(Flags) -> true when Flags :: [init | break | exit].
iaa(Flag) ->
iaa(Flag,{dbg_wx_trace,start,[]}).
@@ -263,6 +316,12 @@ iaa(Flag) ->
%% The given Fnk must have arity 3 or 4.
%% -------------------------------------------
+-spec iaa(Flags, Function) -> true when
+ Flags :: [init | break | exit],
+ Function :: {Module,Name,Args},
+ Module :: module(),
+ Name :: atom(),
+ Args :: [term()].
iaa(Flag,Fnk) ->
int:auto_attach(Flag,Fnk),
true.
@@ -271,6 +330,7 @@ iaa(Flag,Fnk) ->
%% Attach to process.
%% -------------------------------------------
+-spec ia(Pid) -> ok | no_proc when Pid :: pid().
ia(Pid) ->
ia(Pid,{dbg_wx_trace,start}).
@@ -279,6 +339,8 @@ ia(Pid) ->
%% X,Y,Z is combined to a process identity.
%% -------------------------------------------
+-spec ia(X, Y, Z) -> ok | no_proc
+ when X :: integer(), Y :: integer(), Z :: integer().
ia(X,Y,Z) ->
ia(c:pid(X,Y,Z)).
@@ -287,12 +349,24 @@ ia(X,Y,Z) ->
%% Use Fnk == {M,F} as the attaching interface.
%% -------------------------------------------
+-spec ia(Pid, Function) -> ok | no_proc when
+ Pid :: pid(),
+ Function :: {Module,Name},
+ Module :: module(),
+ Name :: atom().
ia(Pid,Fnk) ->
case lists:keymember(Pid, 1, int:snapshot()) of
false -> no_proc;
true -> int:attach(Pid,Fnk)
end.
+-spec ia(X,Y,Z, Function) -> ok | no_proc when
+ X :: integer(),
+ Y :: integer(),
+ Z :: integer(),
+ Function :: {Module,Name},
+ Module :: module(),
+ Name :: atom().
ia(X,Y,Z,Fnk) ->
ia(c:pid(X,Y,Z),Fnk).
@@ -300,6 +374,7 @@ ia(X,Y,Z,Fnk) ->
%% Print status for all interpreted processes.
%% -------------------------------------------
+-spec ip() -> ok.
ip() ->
Stats = int:snapshot(),
hformat("Pid","Initial Call","Status","Info"),
@@ -329,6 +404,7 @@ hformat(A1, A2, A3, A4) ->
%% interpreter.
%% -------------------------------------------
+-spec ic() -> ok.
ic() ->
int:clear().
@@ -336,6 +412,7 @@ ic() ->
%% Help printout
%% -------------------------------------------
+-spec help() -> ok.
help() ->
format("iv() -- print the current version of the interpreter~n"),
format("im() -- pop up a monitor window~n"),
@@ -373,3 +450,4 @@ help() ->
ok.
+
diff --git a/lib/debugger/src/int.erl b/lib/debugger/src/int.erl
index fdf5957182..6f4790d7ed 100644
--- a/lib/debugger/src/int.erl
+++ b/lib/debugger/src/int.erl
@@ -98,8 +98,27 @@
%% Mod = atom()
%% Options = term() ignored
%%--------------------------------------------------------------------
+-spec i(AbsModules) -> ok when
+ AbsModules :: [AbsModule],
+ AbsModule :: Module | File,
+ Module :: module(),
+ File :: file:name_all();
+ (AbsModule) -> {module,Module} | error when
+ AbsModule :: Module | File,
+ Module :: module(),
+ File :: file:name_all().
i(AbsMods) -> i2(AbsMods, local, ok).
i(AbsMods, _Options) -> i2(AbsMods, local, ok).
+
+-spec ni(AbsModules) -> ok when
+ AbsModules :: [AbsModule],
+ AbsModule :: Module | File,
+ Module :: module(),
+ File :: file:name_all();
+ (AbsModule) -> {module,Module} | error when
+ AbsModule :: Module | File,
+ Module :: module(),
+ File :: file:name_all().
ni(AbsMods) -> i2(AbsMods, distributed, ok).
ni(AbsMods, _Options) -> i2(AbsMods, distributed, ok).
@@ -121,7 +140,14 @@ i2(AbsMod, Dist, _Acc) when is_atom(AbsMod); is_list(AbsMod); is_tuple(AbsMod) -
%% n(AbsMods) -> ok
%% nn(AbsMods) -> ok
%%--------------------------------------------------------------------
+-spec n(AbsModule) -> ok when AbsModule :: Module | File | [Module | File],
+ Module :: module(),
+ File :: file:name_all().
n(AbsMods) -> n2(AbsMods, local).
+-spec nn(AbsModule) -> ok when
+ AbsModule :: Module | File | [Module | File],
+ Module :: module(),
+ File :: file:name_all().
nn(AbsMods) -> n2(AbsMods, distributed).
n2([AbsMod|AbsMods], Dist) when is_atom(AbsMod); is_list(AbsMod) ->
@@ -137,6 +163,7 @@ n2(AbsMod, Dist) when is_atom(AbsMod); is_list(AbsMod) ->
%%--------------------------------------------------------------------
%% interpreted() -> [Mod]
%%--------------------------------------------------------------------
+-spec interpreted() -> [Module] when Module :: module().
interpreted() ->
dbg_iserver:safe_call(all_interpreted).
@@ -145,6 +172,8 @@ interpreted() ->
%% Mod = atom()
%% File = string()
%%--------------------------------------------------------------------
+-spec file(Module) -> File | {error,not_loaded} when Module :: module(),
+ File :: file:filename_all().
file(Mod) when is_atom(Mod) ->
dbg_iserver:safe_call({file, Mod}).
@@ -153,6 +182,12 @@ file(Mod) when is_atom(Mod) ->
%% AbsMod = Mod | File
%% Reason = no_src | no_beam | no_debug_info | badarg | {app, App}
%%--------------------------------------------------------------------
+-spec interpretable(AbsModule) -> true | {error,Reason} when
+ AbsModule :: Module | File,
+ Module :: module(),
+ File :: file:name_all(),
+ Reason :: no_src | no_beam | no_debug_info | badarg | {app,App},
+ App :: atom().
interpretable(AbsMod) ->
case check(AbsMod) of
{ok, _Res} -> true;
@@ -170,12 +205,24 @@ interpretable(AbsMod) ->
%% spawn(Mod, Func, [Dist, Pid, Meta | Args]) (living process) or
%% spawn(Mod, Func, [Dist, Pid, Reason, Info | Args]) (dead process)
%%--------------------------------------------------------------------
+-spec auto_attach() -> false | {Flags,Function} when Flags :: [init | break | exit],
+ Function :: {Module,Name,Args},
+ Module :: module(),
+ Name :: atom(),
+ Args :: [term()].
auto_attach() ->
dbg_iserver:safe_call(get_auto_attach).
+-spec auto_attach(false) -> term().
auto_attach(false) ->
dbg_iserver:safe_cast({set_auto_attach, false}).
+-spec auto_attach(Flags, Function) -> term() when
+ Flags :: [init | break | exit],
+ Function :: {Module,Name,Args},
+ Module :: module(),
+ Name :: atom(),
+ Args :: [term()].
auto_attach([], _Function) ->
auto_attach(false);
auto_attach(Flags, {Mod, Func}) ->
@@ -194,9 +241,11 @@ check_flags([]) -> true.
%% stack_trace(Flag)
%% Flag = all | true | no_tail | false
%%--------------------------------------------------------------------
+-spec stack_trace() -> Flag when Flag :: all | no_tail | false.
stack_trace() ->
dbg_iserver:safe_call(get_stack_trace).
+-spec stack_trace(Flag) -> term() when Flag :: all | no_tail | false.
stack_trace(true) ->
stack_trace(all);
stack_trace(Flag) ->
@@ -235,13 +284,19 @@ check_flag(false) -> true.
%% Status = active | inactive
%% Cond = null | Function
%%--------------------------------------------------------------------
+-spec break(Module, Line) -> ok | {error, break_exists}
+ when Module :: module(), Line :: integer().
break(Mod, Line) when is_atom(Mod), is_integer(Line) ->
dbg_iserver:safe_call({new_break, {Mod, Line},
[active, enable, null, null]}).
+-spec delete_break(Module, Line) -> ok
+ when Module :: module(), Line :: integer().
delete_break(Mod, Line) when is_atom(Mod), is_integer(Line) ->
dbg_iserver:safe_cast({delete_break, {Mod, Line}}).
+-spec break_in(Module, Name, Arity) -> ok | {error, function_not_found}
+ when Module :: module(), Name :: atom(), Arity :: integer().
break_in(Mod, Func, Arity) when is_atom(Mod), is_atom(Func), is_integer(Arity) ->
case dbg_iserver:safe_call({is_interpreted, Mod, Func, Arity}) of
{true, Clauses} ->
@@ -251,6 +306,12 @@ break_in(Mod, Func, Arity) when is_atom(Mod), is_atom(Func), is_integer(Arity) -
{error, function_not_found}
end.
+-spec del_break_in(Module, Name, Arity) ->
+ ok | {error, function_not_found}
+ when
+ Module :: module(),
+ Name :: atom(),
+ Arity :: integer().
del_break_in(Mod, Func, Arity) when is_atom(Mod), is_atom(Func), is_integer(Arity) ->
case dbg_iserver:safe_call({is_interpreted, Mod, Func, Arity}) of
{true, Clauses} ->
@@ -269,18 +330,29 @@ first_line({clause,_L,_Vars,_,Exprs}) ->
first_line([Expr|_Exprs]) -> % Expr = {Op, Line, ..varying no of args..}
element(2, Expr).
+-spec no_break() -> ok.
no_break() ->
dbg_iserver:safe_cast(no_break).
+-spec no_break(Module :: term()) -> ok.
no_break(Mod) when is_atom(Mod) ->
dbg_iserver:safe_cast({no_break, Mod}).
+-spec disable_break(Module, Line) -> ok
+ when Module :: module(), Line :: integer().
disable_break(Mod, Line) when is_atom(Mod), is_integer(Line) ->
dbg_iserver:safe_cast({break_option, {Mod, Line}, status, inactive}).
+-spec enable_break(Module, Line) -> ok
+ when Module :: module(), Line :: integer().
enable_break(Mod, Line) when is_atom(Mod), is_integer(Line) ->
dbg_iserver:safe_cast({break_option, {Mod, Line}, status, active}).
+-spec action_at_break(Module, Line, Action) -> ok
+ when
+ Module :: module(),
+ Line :: integer(),
+ Action :: enable | disable | delete.
action_at_break(Mod, Line, Action) when is_atom(Mod), is_integer(Line) ->
check_action(Action),
dbg_iserver:safe_cast({break_option, {Mod, Line}, action, Action}).
@@ -289,17 +361,48 @@ check_action(enable) -> true;
check_action(disable) -> true;
check_action(delete) -> true.
+-spec test_at_break(Module, Line, Function) -> ok when
+ Module :: module(),
+ Line :: integer(),
+ Function :: {Module,Name},
+ Name :: atom().
test_at_break(Mod, Line, Function) when is_atom(Mod), is_integer(Line) ->
check_function(Function),
dbg_iserver:safe_cast({break_option, {Mod, Line}, condition, Function}).
check_function({Mod, Func}) when is_atom(Mod), is_atom(Func) -> true.
+-spec get_binding(Var, Bindings) -> {value,Value} | unbound when Var :: atom(),
+ Bindings :: term(),
+ Value :: term().
get_binding(Var, Bs) ->
dbg_icmd:get_binding(Var, Bs).
+-spec all_breaks() -> [Break] when
+ Break :: {Point,Options},
+ Point :: {Module,Line},
+ Module :: module(),
+ Line :: integer(),
+ Options :: [Status | Trigger | null | Cond],
+ Status :: active | inactive,
+ Trigger :: enable | disable | delete,
+ Cond :: null | Function,
+ Function :: {Module,Name},
+ Name :: atom().
all_breaks() ->
dbg_iserver:safe_call(all_breaks).
+
+-spec all_breaks(Module) -> [Break] when
+ Break :: {Point,Options},
+ Point :: {Module,Line},
+ Module :: module(),
+ Line :: integer(),
+ Options :: [Status | Trigger | null | Cond],
+ Status :: active | inactive,
+ Trigger :: enable | disable | delete,
+ Cond :: null | Function,
+ Function :: {Module,Name},
+ Name :: atom().
all_breaks(Mod) when is_atom(Mod) ->
dbg_iserver:safe_call({all_breaks, Mod}).
@@ -313,12 +416,24 @@ all_breaks(Mod) when is_atom(Mod) ->
%% Line = integer()
%% ExitReason = term()
%%--------------------------------------------------------------------
+-spec snapshot() -> [Snapshot] when
+ Snapshot :: {Pid, Function, Status, Info},
+ Pid :: pid(),
+ Function :: {Module,Name,Args},
+ Module :: module(),
+ Name :: atom(),
+ Args :: [term()],
+ Status :: idle | running | waiting | break | exit | no_conn,
+ Info :: {} | {Module,Line} | ExitReason,
+ Line :: integer(),
+ ExitReason :: term().
snapshot() ->
dbg_iserver:safe_call(snapshot).
%%--------------------------------------------------------------------
%% clear()
%%--------------------------------------------------------------------
+-spec clear() -> ok.
clear() ->
dbg_iserver:safe_cast(clear).
@@ -326,6 +441,7 @@ clear() ->
%% continue(Pid) -> ok | {error, not_interpreted}
%% continue(X, Y, Z) -> ok | {error, not_interpreted}
%%--------------------------------------------------------------------
+-spec continue(Pid :: pid()) -> ok | {error,not_interpreted}.
continue(Pid) when is_pid(Pid) ->
case dbg_iserver:safe_call({get_meta, Pid}) of
{ok, Meta} when is_pid(Meta) ->
@@ -335,6 +451,10 @@ continue(Pid) when is_pid(Pid) ->
Error
end.
+-spec continue(X,Y,Z) -> ok | {error,not_interpreted} when
+ X :: integer(),
+ Y :: integer(),
+ Z :: integer().
continue(X, Y, Z) when is_integer(X), is_integer(Y), is_integer(Z) ->
continue(c:pid(X, Y, Z)).
@@ -746,3 +866,4 @@ del_mod(AbsMod, Dist) ->
erlang:yield()
end),
ok.
+
--
2.35.3