runtime_tools: Update dbg to work with tracing on ports

OTP-13500

2 files changed, 67 insertions, 17 deletions

diff --git a/lib/runtime_tools/src/dbg.erl b/lib/runtime_tools/src/dbg.erl
index 7a4034d0b0..9ab66c7f5c 100644
--- a/lib/runtime_tools/src/dbg.erl
+++ b/lib/runtime_tools/src/dbg.erl
@@ -1114,7 +1114,7 @@ transform_flags([sos|Tail],Acc) -> transform_flags(Tail,[set_on_spawn|Acc]);
 transform_flags([sol|Tail],Acc) -> transform_flags(Tail,[set_on_link|Acc]);
 transform_flags([sofs|Tail],Acc) -> transform_flags(Tail,[set_on_first_spawn|Acc]);
 transform_flags([sofl|Tail],Acc) -> transform_flags(Tail,[set_on_first_link|Acc]);
-transform_flags([all|_],_Acc) -> all()--[silent];
+transform_flags([all|_],_Acc) -> all()--[silent,running];
 transform_flags([F|Tail]=List,Acc) when is_atom(F) ->
     case lists:member(F, all()) of
 	true -> transform_flags(Tail,[F|Acc]);
@@ -1123,9 +1123,9 @@ transform_flags([F|Tail]=List,Acc) when is_atom(F) ->
 transform_flags(Bad,_Acc) -> {error,{bad_flags,Bad}}.
 
 all() ->
-    [send,'receive',call,procs,garbage_collection,running,
+    [send,'receive',call,procs,ports,garbage_collection,running,
      set_on_spawn,set_on_first_spawn,set_on_link,set_on_first_link,
-     timestamp,arity,return_to,silent].
+     timestamp,arity,return_to,silent,running_procs,running_ports].
 
 display_info([Node|Nodes]) ->
     io:format("~nNode ~w:~n",[Node]),
@@ -1146,24 +1146,34 @@ display_info1([]) ->
     ok.
 
 get_info() ->
-    get_info(processes(),[]).
+    get_info(processes(),get_info(erlang:ports(),[])).
 
+get_info([Port|T], Acc) when is_port(Port) ->
+    case pinfo(Port, name) of
+        undefined ->
+            get_info(T,Acc);
+        {name, Name} ->
+            get_info(T,get_tinfo(Port, Name, Acc))
+    end;
 get_info([Pid|T],Acc) ->
     case pinfo(Pid, initial_call) of
         undefined ->
             get_info(T,Acc);
         {initial_call, Call} ->
-	    case tinfo(Pid, flags) of
-		undefined ->
-		    get_info(T,Acc);
-		{flags,[]} ->
-		    get_info(T,Acc);
-		{flags,Flags} ->
-		    get_info(T,[{Pid,Call,Flags}|Acc])
-	    end
+            get_info(T,get_tinfo(Pid, Call, Acc))
     end;
 get_info([],Acc) -> Acc.
 
+get_tinfo(P, Id, Acc) ->
+    case tinfo(P, flags) of
+        undefined ->
+            Acc;
+		{flags,[]} ->
+            Acc;
+        {flags,Flags} ->
+            [{P,Id,Flags}|Acc]
+    end.
+
 format_trace([]) -> [];
 format_trace([Item]) -> [ts(Item)];
 format_trace([Item|T]) -> [ts(Item) ," | ", format_trace(T)].
@@ -1193,9 +1203,17 @@ to_pidspec(X) when is_port(X) ->
         undefined -> {badport, X};
         _ -> X
     end;
-to_pidspec(new) -> new;
-to_pidspec(all) -> all;
-to_pidspec(existing) -> existing;
+to_pidspec(Tag)
+  when Tag =:= all;
+       Tag =:= ports;
+       Tag =:= processes;
+       Tag =:= new;
+       Tag =:= new_ports;
+       Tag =:= new_processes;
+       Tag =:= existing;
+       Tag =:= existing_ports;
+       Tag =:= existing_processes ->
+    Tag;
 to_pidspec(X) when is_atom(X) ->
     case whereis(X) of
 	undefined -> {badpid,X};
@@ -1223,9 +1241,12 @@ to_pid(X) when is_list(X) ->
 to_pid(X) -> {badpid,X}.
 
 
+pinfo(P, X) when node(P) == node(), is_port(P) -> erlang:port_info(P, X);
 pinfo(P, X) when node(P) == node() -> erlang:process_info(P, X);
+pinfo(P, X) when is_port(P) -> check(rpc:call(node(P), erlang, port_info, [P, X]));
 pinfo(P, X) -> check(rpc:call(node(P), erlang, process_info, [P, X])).
 
+
 tinfo(P, X) when node(P) == node() -> erlang:trace_info(P, X);
 tinfo(P, X) -> check(rpc:call(node(P), erlang, trace_info, [P, X])).
 
diff --git a/lib/runtime_tools/test/dbg_SUITE.erl b/lib/runtime_tools/test/dbg_SUITE.erl
index d40efcafef..458c6a2dea 100644
--- a/lib/runtime_tools/test/dbg_SUITE.erl
+++ b/lib/runtime_tools/test/dbg_SUITE.erl
@@ -22,7 +22,7 @@
 %% Test functions
 -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
 	 init_per_group/2,end_per_group/2, 
-	 big/1, tiny/1, simple/1, message/1, distributed/1,
+	 big/1, tiny/1, simple/1, message/1, distributed/1, port/1,
 	 ip_port/1, file_port/1, file_port2/1, file_port_schedfix/1,
 	 ip_port_busy/1, wrap_port/1, wrap_port_time/1,
 	 with_seq_trace/1, dead_suspend/1, local_trace/1,
@@ -45,7 +45,7 @@ end_per_testcase(_Case, Config) ->
 suite() -> [{ct_hooks,[ts_install_cth]}].
 
 all() -> 
-    [big, tiny, simple, message, distributed, ip_port,
+    [big, tiny, simple, message, distributed, port, ip_port,
      file_port, file_port2, file_port_schedfix, ip_port_busy,
      wrap_port, wrap_port_time, with_seq_trace, dead_suspend,
      local_trace, saved_patterns, tracer_exit_on_stop].
@@ -272,6 +272,35 @@ local_trace(Config) when is_list(Config) ->
     end,
     ok.
 
+port(suite) ->
+    [];
+port(doc) ->
+    ["Test that tracing on port works"];
+port(Config) when is_list(Config) ->
+    try
+        S = self(),
+	start(),
+        TestFile = filename:join(proplists:get_value(priv_dir, Config),"port_test"),
+        Fun = dbg:trace_port(file, TestFile),
+
+        %% Do a run to get rid of all extra port operations
+        port_close(Fun()),
+
+	dbg:p(new,ports),
+        Port = Fun(),
+        port_close(Port),
+	stop(),
+
+        TraceFileDrv = list_to_atom(lists:flatten(["trace_file_drv n ",TestFile])),
+	[{trace,Port,open,S,TraceFileDrv},
+         {trace,Port,getting_linked,S},
+         {trace,Port,closed,normal},
+         {trace,Port,unlink,S}] = flush()
+    after
+	dbg:stop()
+    end,
+    ok.
+
 saved_patterns(suite) ->
     [];
 saved_patterns(doc) ->