Skip to content
Browse files

gproc:info(P,current_function) return value

  • Loading branch information...
1 parent cf82595 commit 9cbb0e7b653741d1e2b8a556d0bac97ecb29ebce @uwiger uwiger committed with Dec 2, 2011
Showing with 78 additions and 63 deletions.
  1. +43 −5 src/gproc.erl
  2. +35 −58 test/gproc_tests.erl
View
48 src/gproc.erl
@@ -1339,8 +1339,48 @@ info(Pid) when is_pid(Pid) ->
%% registered to the process Pid. For other values of Item, it returns the
%% same as [http://www.erlang.org/doc/man/erlang.html#process_info-2].
%% @end
-info(Pid, ?MODULE) ->
- Keys = ets:select(?TAB, [{ {{Pid,'$1'}, '_'}, [], ['$1'] }]),
+info(Pid, gproc) ->
+ gproc_info(Pid, '_');
+info(Pid, {gproc, Pat}) ->
+ gproc_info(Pid, Pat);
+info(Pid, current_function) ->
+ {_, T} = process_info(Pid, backtrace),
+ info_cur_f(T, process_info(Pid, current_function));
+info(Pid, I) ->
+ process_info(Pid, I).
+
+%% We don't want to return the internal gproc:info() function as current
+%% function, so we grab the 'backtrace' and extract the call stack from it,
+%% filtering out the functions gproc:info/_ and gproc:'-info/1-lc...' entries.
+%%
+%% This is really an indication that wrapping the process_info() BIF was a
+%% bad idea to begin with... :P
+%%
+info_cur_f(T, Default) ->
+ {match, Matches} = re:run(T,<<"\\(([^\\)]+):(.+)/([0-9]+)">>,
+ [global,{capture,[1,2,3],list}]),
+ case lists:dropwhile(fun(["gproc","info",_]) -> true;
+ (["gproc","'-info/1-lc" ++ _, _]) -> true;
+ (_) -> false
+ end, Matches) of
+ [] ->
+ Default;
+ [[M,F,A]|_] ->
+ {current_function,
+ {to_atom(M), to_atom(F), list_to_integer(A)}}
+ end.
+
+to_atom(S) ->
+ case erl_scan:string(S) of
+ {ok, [{atom,_,A}|_],_} ->
+ A;
+ _ ->
+ list_to_atom(S)
+ end.
+
+gproc_info(Pid, Pat) ->
+ Keys = ets:select(?TAB, [{ {{Pid,Pat}, '_'}, [], [{element,2,
+ {element,1,'$_'}}] }]),
{?MODULE, lists:zf(
fun(K) ->
try V = get_value(K, Pid),
@@ -1349,9 +1389,7 @@ info(Pid, ?MODULE) ->
error:_ ->
false
end
- end, Keys)};
-info(Pid, I) ->
- process_info(Pid, I).
+ end, Keys)}.
%% @spec () -> ok
%%
View
93 test/gproc_tests.erl
@@ -117,6 +117,8 @@ reg_test_() ->
, ?_test(t_is_clean())
, {spawn, ?_test(?debugVal(t_subscribe()))}
, ?_test(t_is_clean())
+ , {spawn, ?_test(t_gproc_info())}
+ , ?_test(t_is_clean())
]}.
t_simple_reg() ->
@@ -464,64 +466,39 @@ t_get_env_inherit() ->
[{inherit, {n,l,get_env_p}}])),
?assertEqual(ok, t_call(P, die)).
-t_monitor() ->
- Me = self(),
- P = spawn_link(fun() ->
- gproc:reg({n,l,a}),
- Me ! continue,
- t_loop()
- end),
- receive continue ->
- ok
- end,
- Ref = gproc:monitor({n,l,a}),
- ?assertEqual(ok, t_call(P, die)),
- receive
- M ->
- ?assertEqual({gproc,unreg,Ref,{n,l,a}}, M)
- end.
-
-t_monitor_give_away() ->
- Me = self(),
- P = spawn_link(fun() ->
- gproc:reg({n,l,a}),
- Me ! continue,
- t_loop()
- end),
- receive continue ->
- ok
- end,
- Ref = gproc:monitor({n,l,a}),
- ?assertEqual(ok, t_call(P, {give_away, {n,l,a}})),
- receive
- M ->
- ?assertEqual({gproc,{migrated,Me},Ref,{n,l,a}}, M)
- end,
- ?assertEqual(ok, t_call(P, die)).
-
-t_subscribe() ->
- Key = {n,l,a},
- ?assertEqual(ok, gproc_monitor:subscribe(Key)),
- ?assertEqual({gproc_monitor, Key, undefined}, get_msg()),
- P = spawn_link(fun() ->
- gproc:reg({n,l,a}),
- t_loop()
- end),
- ?assertEqual({gproc_monitor, Key, P}, get_msg()),
- ?assertEqual(ok, t_call(P, {give_away, Key})),
- ?assertEqual({gproc_monitor, Key, {migrated,self()}}, get_msg()),
- gproc:give_away(Key, P),
- ?assertEqual({gproc_monitor, Key, {migrated,P}}, get_msg()),
- ?assertEqual(ok, t_call(P, die)),
- ?assertEqual({gproc_monitor, Key, undefined}, get_msg()),
- ?assertEqual(ok, gproc_monitor:unsubscribe(Key)).
-
-get_msg() ->
- receive M ->
- M
- after 1000 ->
- timeout
- end.
+%% What we test here is that we return the same current_function as the
+%% process_info() BIF. As we parse the backtrace dump, we check with some
+%% weirdly named functions.
+t_gproc_info() ->
+ {A,B} = '-t1-'(),
+ ?assertEqual(A,B),
+ {C,D} = '\'t2'(),
+ ?assertEqual(C,D),
+ {E,F} = '\'t3\''(),
+ ?assertEqual(E,F),
+ {G,H} = t4(),
+ ?assertEqual(G,H).
+
+'-t1-'() ->
+ {_, I0} = process_info(self(), current_function),
+ {_, I} = gproc:info(self(), current_function),
+ {I0, I}.
+
+'\'t2'() ->
+ {_, I0} = process_info(self(), current_function),
+ {_, I} = gproc:info(self(), current_function),
+ {I0, I}.
+
+'\'t3\''() ->
+ {_, I0} = process_info(self(), current_function),
+ {_, I} = gproc:info(self(), current_function),
+ {I0, I}.
+
+
+t4() ->
+ {_, I0} = process_info(self(), current_function),
+ {_, I} = gproc:info(self(), current_function),
+ {I0, I}.
t_loop() ->
receive

0 comments on commit 9cbb0e7

Please sign in to comment.
Something went wrong with that request. Please try again.