Browse Source

fixes noted by @jlouis, first eunit suite, bug fixes around mreg

Ulf Wiger 14 years ago
parent
commit
9d5340e024
7 changed files with 337 additions and 94 deletions
  1. 11 0
      Makefile
  2. 16 1
      include/gproc.hrl
  3. 6 2
      src/Makefile
  4. 103 35
      src/Unit-Quick-Files/gproc_eqc.erl
  5. 145 25
      src/gproc.erl
  6. 1 1
      src/gproc_app.erl
  7. 55 30
      src/gproc_lib.erl

+ 11 - 0
Makefile

@@ -26,7 +26,18 @@ all:
 	for D in $(DIRS) ; do \
 	for D in $(DIRS) ; do \
 	(cd $$D; ${MAKE}) ; \
 	(cd $$D; ${MAKE}) ; \
 	done
 	done
+
 clean:
 clean:
 	for D in $(DIRS) ; do \
 	for D in $(DIRS) ; do \
 	(cd $$D; ${MAKE} clean) ; \
 	(cd $$D; ${MAKE} clean) ; \
 	done
 	done
+
+eunit:
+	for D in $(DIRS) ; do \
+	(cd $$D; ${MAKE} eunit) ; \
+	done
+
+test:
+	for D in $(DIRS) ; do \
+	(cd $$D; ${MAKE} test) ; \
+	done

+ 16 - 1
include/gproc.hrl

@@ -13,8 +13,23 @@
 %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
 %% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
 %% AB. All Rights Reserved.''
 %% AB. All Rights Reserved.''
 %%
 %%
-%% @author Ulf Wiger <ulf.wiger@ericsson.com>
+%% @author Ulf Wiger <ulf.wiger@erlang-solutions.com>
 %% 
 %% 
 %% gproc.hrl: Common definitions
 %% gproc.hrl: Common definitions
 
 
 -define(TAB, gproc).
 -define(TAB, gproc).
+
+
+-type type()     :: n | p | c | a.
+-type scope()    :: l | g.
+-type context()  :: {scope(),type()} | type().
+-type sel_type() :: n | p | c | a |
+                    names | props | counters | aggr_counters.
+
+-type sel_var() :: '_' | atom().
+-type keypat()  :: {sel_type() | sel_var(), l | g | sel_var(), any()}.
+-type pidpat()  :: pid() | sel_var().
+-type headpat() :: {keypat(),pidpat(),any()}.
+-type key()     :: {type(), scope(), any()}.
+
+-type sel_pattern() :: [{headpat(), list(), list()}].

+ 6 - 2
src/Makefile

@@ -31,9 +31,9 @@ vpath %.pdf ../doc
 ERLC = erlc -W -I ../include -o ../ebin
 ERLC = erlc -W -I ../include -o ../ebin
 ERLC += +debug_info
 ERLC += +debug_info
 
 
-EQC ?= /host/dev/eqc-1.16
+#EQC ?= /host/dev/eqc-1.16
 
 
-EQC_ERLC = $(ERLC) -I $(EQC)/include
+EQC_ERLC = $(ERLC) -pa $(EQC)/ebin
 EQC_ERL = erl -pz ../ebin -pz $(EQC)/ebin -pz ./Unit-Quick-Files -kernel error_logger silent -sasl errlog_type error
 EQC_ERL = erl -pz ../ebin -pz $(EQC)/ebin -pz ./Unit-Quick-Files -kernel error_logger silent -sasl errlog_type error
 
 
 SOURCES = $(wildcard *.erl)
 SOURCES = $(wildcard *.erl)
@@ -64,6 +64,10 @@ doc: ../doc/edoc-info
 	erl -noshell -eval 'edoc:application($(APP),"..",[])' -s init stop
 	erl -noshell -eval 'edoc:application($(APP),"..",[])' -s init stop
 
 
 ## test targets
 ## test targets
+eunit: all 
+	erl -noshell -boot start_clean -sasl errlog_type error \
+	-pa ../ebin -eval 'eunit:test("../ebin", [verbose])' -s init stop
+
 test : all ./Unit-Quick-Files/gproc_eqc.beam
 test : all ./Unit-Quick-Files/gproc_eqc.beam
 	$(EQC_ERL) -s gproc_eqc run -s erlang halt
 	$(EQC_ERL) -s gproc_eqc run -s erlang halt
 
 

+ 103 - 35
src/Unit-Quick-Files/gproc_eqc.erl

@@ -12,6 +12,7 @@
 
 
 -compile(export_all).
 -compile(export_all).
 
 
+
 %%
 %%
 %% QUESTIONS:
 %% QUESTIONS:
 %%
 %%
@@ -52,11 +53,13 @@
 
 
 
 
 %% external API
 %% external API
-start_test() ->
-    eqc:module({numtests, 500}, ?MODULE).
+
+%% UW: renamed to avoid confusion with eunit
+all_tests() ->
+    eqc:module({numtests, 3000}, ?MODULE).
 
 
 run() ->
 run() ->
-    run(500).
+    run(3000).
 
 
 run(Num) ->
 run(Num) ->
     eqc:quickcheck(eqc:numtests(Num, prop_gproc())).
     eqc:quickcheck(eqc:numtests(Num, prop_gproc())).
@@ -82,6 +85,7 @@ command(S) ->
                   %% unregister
                   %% unregister
                   , {call,?MODULE,unreg,          [elements(S#state.pids), key()]}
                   , {call,?MODULE,unreg,          [elements(S#state.pids), key()]}
                   %% many register
                   %% many register
+                  , {call, ?MODULE, mreg,         ?LET({Pid,Class,Scope}, {elements(S#state.pids),class(),scope()}, [Pid, Class, Scope, mreg_values(S, Class, Scope)])}
                   %%, {call,?MODULE,mreg,           [elements(S#state.pids), class(), scope()
                   %%, {call,?MODULE,mreg,           [elements(S#state.pids), class(), scope()
                   %%                                 , list({name(), value()})]}
                   %%                                 , list({name(), value()})]}
 
 
@@ -114,12 +118,19 @@ class() -> elements([n,p,c,a]).
 scope() -> l.
 scope() -> l.
 
 
 %% generator name
 %% generator name
-name() -> elements([x,y,z,w]).
+name() -> elements(names()).
+
+names() -> [x,y,z,w].
+    
 
 
 %% generator key
 %% generator key
-key() -> #key{class=class(), scope=scope(), name=name()}.
+key() -> key(class(), scope(), name()).
 
 
-name_key() -> #key{class=n, scope=scope(), name=name()}.
+key(Class, Scope, Name) ->
+    #key{class=Class, scope=Scope, name=Name}.
+
+name_key() ->
+    key(n, scope(), name()).
     
     
 
 
 %% generator value
 %% generator value
@@ -130,6 +141,18 @@ value() -> frequency([{8, int()}, {1, undefined}, {1, make_ref()}]).
 reg_value(#key{class=C}) when C == a; C == c -> int();
 reg_value(#key{class=C}) when C == a; C == c -> int();
 reg_value(_) -> value().
 reg_value(_) -> value().
 
 
+
+mreg_values(_S, Class, Scope) ->
+    ?LET(Names, subset(names()),
+         [?LET(K, key(Class, Scope, N), {K, reg_value(K)}) || N <- Names]).
+
+
+%% Snipped from the TrapExit QuickCheck tutorials
+%% http://trapexit.org/SubSetGenerator
+subset(Generators) ->
+   ?LET(Keep,[ {bool(),G} || G<-Generators],
+	[ G || {true,G}<-Keep]).
+
 %% helpers
 %% helpers
 is_register_ok(_S,_Pid,#key{class=c},Value) when not is_integer(Value) ->
 is_register_ok(_S,_Pid,#key{class=c},Value) when not is_integer(Value) ->
     false;
     false;
@@ -139,6 +162,11 @@ is_register_ok(S,Pid,Key,_Value) ->
     [] == [ Pid1 || #reg{pid=Pid1,key=Key1}
     [] == [ Pid1 || #reg{pid=Pid1,key=Key1}
                         <- S#state.regs, is_register_eq(Pid,Key,Pid1,Key1) ].
                         <- S#state.regs, is_register_eq(Pid,Key,Pid1,Key1) ].
 
 
+is_mreg_ok(S, Pid, List) ->
+    lists:all(fun({Key, Value}) ->
+                      is_register_ok(S, Pid, Key, Value)
+              end, List).
+
 is_register_eq(_PidA,#key{class=Class}=KeyA,_PidB,KeyB)
 is_register_eq(_PidA,#key{class=Class}=KeyA,_PidB,KeyB)
   when Class == n; Class ==a ->
   when Class == n; Class ==a ->
     KeyA==KeyB;
     KeyA==KeyB;
@@ -178,28 +206,17 @@ next_state(S,_V,{call,_,reg,[Pid,Key,Value]}) ->
         false ->
         false ->
             S;
             S;
         true ->
         true ->
-            case Key of
-                #key{class=a,name=Name} ->
-                    %% initialize aggr counter
-                    FunC = fun(#reg{key=#key{class=Class1,name=Name1}}) -> (Class1 == c andalso Name==Name1) end,
-                    {Regs, _Others} = lists:partition(FunC, S#state.regs),
-                    InitialValue = lists:sum([ V || #reg{value=V} <- Regs ]),
-                    S#state{regs=[#reg{pid=Pid,key=Key,value=InitialValue}|S#state.regs]};
-                #key{class=c,name=Name} ->
-                    S1 = S#state{regs=[#reg{pid=Pid,key=Key,value=Value}|S#state.regs]},
-                    %% update aggr counter
-                    FunA = fun(#reg{key=#key{class=Class1,name=Name1}}) -> (Class1 == a andalso Name==Name1) end,
-                    case lists:partition(FunA, S1#state.regs) of
-                        {[Reg], Others} ->
-                            S1#state{regs=[Reg#reg{value=Reg#reg.value+Value}|Others]};
-                        {[], _Others} ->
-                            S1
-                    end;
-                _ ->
-                    S#state{regs=[#reg{pid=Pid,key=Key,value=Value}|S#state.regs],
-                            waiters = [W || {K,_} = W <- S#state.waiters,
-                                            K =/= Key]}
-            end
+            update_state_reg(S, Pid, Key, Value)
+    end;
+next_state(S,_V,{call,_,mreg,[Pid, _Class, _Scope, List]}) ->
+    case is_mreg_ok(S, Pid, List) of
+        false ->
+            S;
+        true ->
+            lists:foldl(
+              fun({Key, Value}, Acc) ->
+                      update_state_reg(Acc, Pid, Key, Value)
+              end, S, List)
     end;
     end;
 %% unreg
 %% unreg
 next_state(S,_V,{call,_,unreg,[Pid,Key]}) ->
 next_state(S,_V,{call,_,unreg,[Pid,Key]}) ->
@@ -284,13 +301,49 @@ next_state(S,_V,{call,_,_,_}) ->
     S.
     S.
 
 
 
 
+update_state_reg(S, Pid, Key, Value) ->
+    case Key of
+        #key{class=a,name=Name} ->
+            %% initialize aggr counter
+            FunC = fun(#reg{key=#key{class=Class1,name=Name1}}) -> (Class1 == c andalso Name==Name1) end,
+            {Regs, _Others} = lists:partition(FunC, S#state.regs),
+            InitialValue = lists:sum([ V || #reg{value=V} <- Regs ]),
+            S#state{regs=[#reg{pid=Pid,key=Key,value=InitialValue}|S#state.regs]};
+        #key{class=c,name=Name} ->
+            S1 = S#state{regs=[#reg{pid=Pid,key=Key,value=Value}|S#state.regs]},
+            %% update aggr counter
+            FunA = fun(#reg{key=#key{class=Class1,name=Name1}}) -> (Class1 == a andalso Name==Name1) end,
+            case lists:partition(FunA, S1#state.regs) of
+                {[Reg], Others} ->
+                    S1#state{regs=[Reg#reg{value=Reg#reg.value+Value}|Others]};
+                {[], _Others} ->
+                    S1
+            end;
+        _ ->
+            S#state{regs=[#reg{pid=Pid,key=Key,value=Value}|S#state.regs],
+                    waiters = [W || {K,_} = W <- S#state.waiters,
+                                    K =/= Key]}
+    end.
+
+
+
 %% Precondition, checked before command is added to the command
 %% Precondition, checked before command is added to the command
 %% sequence
 %% sequence
+precondition(S, {call,_,reg, [Pid, _Key, _Value]}) ->
+    lists:member(Pid, S#state.pids);
+precondition(S, {call,_,unreg, [Pid, _Key]}) ->
+    lists:member(Pid, S#state.pids);
 precondition(S, {call,_,await_new,[#key{class=C}=Key]}) ->
 precondition(S, {call,_,await_new,[#key{class=C}=Key]}) ->
     C == n andalso
     C == n andalso
         not lists:keymember(Key,#reg.key,S#state.regs);
         not lists:keymember(Key,#reg.key,S#state.regs);
-precondition(S, {call,_,await_existing,[#reg{key=#key{class=C}}]}) ->
-    C == n;
+precondition(S, {call,_,mreg,[Pid, Class, _Scope, List]}) ->
+    %% TODO: lift this restriction to generate all classes mreg can handle
+    Class == n andalso
+	lists:member(Pid, S#state.pids) andalso
+        lists:all(fun({#key{class=C},_}) -> C == n end, List);
+precondition(S, {call,_,await_existing,[#reg{key=#key{class=C}=Key}]}) ->
+    C == n andalso
+	lists:keymember(Key, #reg.key, S#state.regs);
 precondition(S,{call,_,get_value,[Pid,_]}) ->
 precondition(S,{call,_,get_value,[Pid,_]}) ->
 	lists:member(Pid,S#state.pids);
 	lists:member(Pid,S#state.pids);
 precondition(_S,{call,_,_,_}) ->
 precondition(_S,{call,_,_,_}) ->
@@ -333,6 +386,17 @@ postcondition(S,{call,_,reg,[Pid,Key,Value]},Res) ->
             is_unregister_ok(S,Pid,Key)
             is_unregister_ok(S,Pid,Key)
                 orelse not is_register_ok(S,Pid,Key,Value)
                 orelse not is_register_ok(S,Pid,Key,Value)
     end;
     end;
+postcondition(S,{call,_,mreg,[Pid,_Class,_Scope,List]},Res) ->
+    case Res of
+        true ->
+            is_mreg_ok(S,Pid,List)
+                andalso lists:all(fun({K,V}) ->
+                                          check_waiters(Pid,K,V, S#state.waiters)
+                                  end, List);
+        {'EXIT', {badarg,_}} ->
+            not is_mreg_ok(S,Pid,List)
+    end;
+    
 %% unreg
 %% unreg
 postcondition(S,{call,_,unreg,[Pid,Key]},Res) ->
 postcondition(S,{call,_,unreg,[Pid,Key]},Res) ->
     case Res of
     case Res of
@@ -392,9 +456,9 @@ postcondition(S,{call,_,lookup_pids,[#key{class=Class}=Key]},Res)
     Pids = [ Pid1 || #reg{pid=Pid1,key=Key1} <- S#state.regs
     Pids = [ Pid1 || #reg{pid=Pid1,key=Key1} <- S#state.regs
                          , Key==Key1 ],
                          , Key==Key1 ],
     lists:sort(Res) == lists:sort(Pids);
     lists:sort(Res) == lists:sort(Pids);
-postcondition(S,{call,_,await_new,[#key{}=Key]}, Pid) ->
+postcondition(S,{call,_,await_new,[#key{}]}, Pid) ->
     is_pid(Pid);
     is_pid(Pid);
-postcondition(S,{call,_,await_existing,[#reg{key=Key,value=V}]}, {P1,V1}) ->
+postcondition(S,{call,_,await_existing,[#reg{key=Key}]}, {P1,V1}) ->
     case lists:keyfind(Key, #reg.key, S#state.regs) of
     case lists:keyfind(Key, #reg.key, S#state.regs) of
         #reg{pid=P1, value = V1} -> true;
         #reg{pid=P1, value = V1} -> true;
         _ -> false
         _ -> false
@@ -508,6 +572,10 @@ where(#key{class=Class,scope=Scope,name=Name}) ->
 reg(Pid,#key{class=Class,scope=Scope,name=Name},Value) ->
 reg(Pid,#key{class=Class,scope=Scope,name=Name},Value) ->
     do(Pid, fun() -> catch gproc:reg({Class,Scope,Name},Value) end).
     do(Pid, fun() -> catch gproc:reg({Class,Scope,Name},Value) end).
 
 
+mreg(Pid, Class, Scope, List) ->
+    do(Pid, fun() -> catch gproc:mreg(Class,Scope,[{Name,Value} || {#key{name = Name}, Value} <- List]) end).
+                     
+
 %% unreg
 %% unreg
 unreg(Pid,#key{class=Class,scope=Scope,name=Name}) ->
 unreg(Pid,#key{class=Class,scope=Scope,name=Name}) ->
     do(Pid, fun() -> catch gproc:unreg({Class,Scope,Name}) end).
     do(Pid, fun() -> catch gproc:unreg({Class,Scope,Name}) end).
@@ -549,9 +617,9 @@ do(Pid, F) ->
 
 
 await_existing(#reg{key = #key{class=Class,scope=Scope,name=Name}}) ->
 await_existing(#reg{key = #key{class=Class,scope=Scope,name=Name}}) ->
     %% short timeout, this call is expected to work
     %% short timeout, this call is expected to work
-    gproc:await({Class,Scope,Name}, 1000).
+    gproc:await({Class,Scope,Name}, 10000).
 
 
-await_new(#key{class=Class,scope=Scope,name=Name} = Key) ->
+await_new(#key{class=Class,scope=Scope,name=Name}) ->
     spawn(
     spawn(
       fun() ->
       fun() ->
               Res = (catch gproc:await({Class,Scope,Name})),
               Res = (catch gproc:await({Class,Scope,Name})),
@@ -573,7 +641,7 @@ check_waiters(Pid, Key, Value, Waiters) ->
                       end, WPids)
                       end, WPids)
     end.
     end.
 
 
-check_waiter(WPid, Pid, Key, Value) ->   
+check_waiter(WPid, Pid, _Key, Value) ->   
     MRef = erlang:monitor(process, WPid),
     MRef = erlang:monitor(process, WPid),
     WPid ! {self(), send_result},
     WPid ! {self(), send_result},
     receive
     receive

+ 145 - 25
src/gproc.erl

@@ -88,7 +88,12 @@
          code_change/3,
          code_change/3,
          terminate/2]).
          terminate/2]).
 
 
+%% this shouldn't be necessary
+-export([audit_process/1]).
+
+
 -include("gproc.hrl").
 -include("gproc.hrl").
+-include_lib("eunit/include/eunit.hrl").
 
 
 -define(SERVER, ?MODULE).
 -define(SERVER, ?MODULE).
 %%-define(l, l(?LINE)). % when activated, calls a traceable empty function
 %%-define(l, l(?LINE)). % when activated, calls a traceable empty function
@@ -527,7 +532,11 @@ where({T,_,_}=Key) ->
     if T==n orelse T==a ->
     if T==n orelse T==a ->
             case ets:lookup(?TAB, {Key,T}) of
             case ets:lookup(?TAB, {Key,T}) of
                 [{_, P, _Value}] ->
                 [{_, P, _Value}] ->
-                    P;
+                    case is_process_alive(P) of
+			true -> P;
+			false ->
+			    undefined
+		    end;
                 _ ->  % may be [] or [{Key,Waiters}]
                 _ ->  % may be [] or [{Key,Waiters}]
                     undefined
                     undefined
             end;
             end;
@@ -545,13 +554,13 @@ where({T,_,_}=Key) ->
 %% @end
 %% @end
 %%
 %%
 lookup_pids({T,_,_} = Key) ->
 lookup_pids({T,_,_} = Key) ->
-    if T==n orelse T==a ->
-            ets:select(?TAB, [{{{Key,T}, '$1', '_'},[],['$1']}]);
-       true ->
-            ets:select(?TAB, [{{{Key,'_'}, '$1', '_'},[],['$1']}])
-%%%        true ->
-%%%             erlang:error(badarg)
-    end.
+    L = if T==n orelse T==a ->
+		ets:select(?TAB, [{{{Key,T}, '$1', '_'},[],['$1']}]);
+	   true ->
+		ets:select(?TAB, [{{{Key,'_'}, '$1', '_'},[],['$1']}])
+	end,
+    [P || P <- L, is_process_alive(P)].
+	  
 
 
 %% @spec (Key::key()) -> [{pid(), Value}]
 %% @spec (Key::key()) -> [{pid(), Value}]
 %%
 %%
@@ -563,11 +572,13 @@ lookup_pids({T,_,_} = Key) ->
 %% @end
 %% @end
 %%
 %%
 lookup_values({T,_,_} = Key) ->
 lookup_values({T,_,_} = Key) ->
-    if T==n orelse T==a ->
-            ets:select(?TAB, [{{{Key,T}, '$1', '$2'},[],[{{'$1','$2'}}]}]);
-       true ->
-            ets:select(?TAB, [{{{Key,'_'}, '$1', '$2'},[],[{{'$1','$2'}}]}])
-    end.
+    L = if T==n orelse T==a ->
+		ets:select(?TAB, [{{{Key,T}, '$1', '$2'},[],[{{'$1','$2'}}]}]);
+	   true ->
+		ets:select(?TAB, [{{{Key,'_'}, '$1', '$2'},[],[{{'$1','$2'}}]}])
+	end,
+    [Pair || {P,_} = Pair <- L, is_process_alive(P)].
+
 
 
 
 
 %% @spec (Key::key(), Incr::integer()) -> integer()
 %% @spec (Key::key(), Incr::integer()) -> integer()
@@ -818,6 +829,14 @@ handle_call({set, {_,l,_} = Key, Value}, {Pid,_}, S) ->
         false ->
         false ->
             {reply, badarg, S}
             {reply, badarg, S}
     end;
     end;
+handle_call({audit_process, Pid}, _, S) ->
+    case is_process_alive(Pid) of
+	false ->
+	    process_is_down(Pid);
+	true ->
+	    ignore
+    end,
+    {reply, ok, S};
 handle_call(_, _, S) ->
 handle_call(_, _, S) ->
     {reply, badarg, S}.
     {reply, badarg, S}.
 
 
@@ -884,7 +903,7 @@ try_insert_reg({T,l,_} = Key, Val, Pid) ->
                         true ->
                         true ->
                             false;
                             false;
                         false ->
                         false ->
-                            process_is_down(Pid),
+                            process_is_down(OtherPid),
                             true = gproc_lib:insert_reg(Key, Val, Pid, l)
                             true = gproc_lib:insert_reg(Key, Val, Pid, l)
                     end;
                     end;
                 [] ->
                 [] ->
@@ -894,17 +913,50 @@ try_insert_reg({T,l,_} = Key, Val, Pid) ->
             true
             true
     end.
     end.
 
 
+
+-spec audit_process(pid()) -> ok.
+
+audit_process(Pid) when is_pid(Pid) ->
+    gen_server:call(gproc, {audit_process, Pid}, infinity).
+    
+
+-spec process_is_down(pid()) -> ok.
+
 process_is_down(Pid) ->
 process_is_down(Pid) ->
-    Keys = ets:select(?TAB, [{{{Pid,'$1'},'$2'},
-                              [{'==',{element,2,'$1'},l}], [{{'$1','$2'}}]}]),
-    ets:select_delete(?TAB, [{{{Pid,{'_',l,'_'}},'_'}, [], [true]}]),
+    %% delete the monitor marker
+    %% io:fwrite(user, "process_is_down(~p) - ~p~n", [Pid,ets:tab2list(?TAB)]),
     ets:delete(?TAB, {Pid,l}),
     ets:delete(?TAB, {Pid,l}),
-    lists:foreach(fun({Key,r}) ->
-                          gproc_lib:remove_reg_1(Key, Pid);
-                     ({Key,w}) ->
-                          gproc_lib:remove_waiter(Key, Pid)
-                  end, Keys).
-
+    Revs = ets:select(?TAB, [{{{Pid,'$1'},r}, 
+                              [{'==',{element,2,'$1'},l}], ['$1']}]),
+    lists:foreach(
+      fun({n,l,_}=K) ->
+              Key = {K,n},
+              case ets:lookup(?TAB, Key) of
+                  [{_, Pid, _}] ->
+                      ets:delete(?TAB, Key);
+                  [{_, Waiters}] ->
+                      case [W || {P,_} = W <- Waiters,
+                                 P =/= Pid] of
+                          [] ->
+                              ets:delete(?TAB, Key);
+                          Waiters1 ->
+                              ets:insert(?TAB, {Key, Waiters1})
+                      end;
+                  [] ->
+                      true
+              end;
+         ({c,l,C} = K) ->
+              Key = {K, Pid},
+              [{_, _, Value}] = ets:lookup(?TAB, Key),
+              ets:delete(?TAB, Key),
+              gproc_lib:update_aggr_counter(l, C, -Value);
+         ({a,l,_} = K) -> 
+              ets:delete(?TAB, {K,a});
+         ({p,_,_} = K) ->
+              ets:delete(?TAB, {K, Pid})
+      end, Revs),
+    ets:select_delete(?TAB, [{{{Pid,{'_',l,'_'}},'_'}, [], [true]}]),
+    ok.
 
 
 create_tabs() ->
 create_tabs() ->
     ets:new(?MODULE, [ordered_set, public, named_table]).
     ets:new(?MODULE, [ordered_set, public, named_table]).
@@ -1169,7 +1221,7 @@ qlc_next(_, '$end_of_table') -> [];
 qlc_next(Scope, K) ->
 qlc_next(Scope, K) ->
     case ets:lookup(?TAB, K) of
     case ets:lookup(?TAB, K) of
         [{{Key,_}, Pid, V}] ->
         [{{Key,_}, Pid, V}] ->
-            [{Key,Pid,V} | fun() -> qlc_next(Scope, next(Scope, K)) end];
+            [{Key,Pid,V}] ++ fun() -> qlc_next(Scope, next(Scope, K)) end;
         [] ->
         [] ->
             qlc_next(Scope, next(Scope, K))
             qlc_next(Scope, next(Scope, K))
     end.
     end.
@@ -1178,7 +1230,7 @@ qlc_prev(_, '$end_of_table') -> [];
 qlc_prev(Scope, K) ->
 qlc_prev(Scope, K) ->
     case ets:lookup(?TAB, K) of
     case ets:lookup(?TAB, K) of
         [{{Key,_},Pid,V}] ->
         [{{Key,_},Pid,V}] ->
-            [{Key,Pid,V} | fun() -> qlc_prev(Scope, prev(Scope, K)) end];
+            [{Key,Pid,V}] ++ fun() -> qlc_prev(Scope, prev(Scope, K)) end;
         [] ->
         [] ->
             qlc_prev(Scope, prev(Scope, K))
             qlc_prev(Scope, prev(Scope, K))
     end.
     end.
@@ -1200,3 +1252,71 @@ is_unique({_,a}) -> true;
 is_unique(_) -> false.
 is_unique(_) -> false.
 
 
 
 
+%% =============== EUNIT tests
+
+reg_test_() ->
+    {setup,
+     fun() ->
+             application:start(gproc)
+     end,
+     fun(_) ->
+             application:stop(gproc)
+     end,
+     [
+      {spawn, ?_test(t_simple_reg())}
+      , ?_test(t_is_clean())
+      , {spawn, ?_test(t_simple_prop())}
+      , ?_test(t_is_clean())
+      , {spawn, ?_test(t_await())}
+      , ?_test(t_is_clean())
+      , {spawn, ?_test(t_simple_mreg())}
+      , ?_test(t_is_clean())
+     ]}.
+
+t_simple_reg() ->
+    ?debugFmt("self() = ~p~n", [self()]),
+    ?assert(gproc:reg({n,l,name}) =:= true),
+    ?assert(gproc:where({n,l,name}) =:= self()),
+    ?assert(gproc:unreg({n,l,name}) =:= true),
+    ?assert(gproc:where({n,l,name}) =:= undefined).
+
+
+                       
+t_simple_prop() ->
+    ?assert(gproc:reg({p,l,prop}) =:= true),
+    ?assert(t_other_proc(fun() ->
+                                 ?assert(gproc:reg({p,l,prop}) =:= true)
+                         end) =:= ok),
+    ?assert(gproc:unreg({p,l,prop}) =:= true).
+
+t_other_proc(F) ->
+    ?debugFmt("self() = ~p~n", [self()]),
+    {_Pid,Ref} = spawn_monitor(fun() -> exit(F()) end),
+    receive
+        {'DOWN',Ref,_,_,R} ->
+            R
+    after 10000 ->
+            erlang:error(timeout)
+    end.
+
+t_await() ->
+    Me = self(),
+    {_Pid,Ref} = spawn_monitor(
+                   fun() -> exit(?assert(gproc:await({n,l,t_await}) =:= {Me,val})) end),
+    ?assert(gproc:reg({n,l,t_await},val) =:= true),
+    receive
+        {'DOWN', Ref, _, _, R} ->
+            ?assertEqual(R, ok)
+    after 10000 ->
+            erlang:error(timeout)
+    end.
+
+t_is_clean() ->
+    sys:get_status(gproc), % in order to synch
+    T = ets:tab2list(gproc),
+    ?debugFmt("T = ~p~n", [T]),
+    ?assert(T =:= []).
+                                        
+
+t_simple_mreg() ->
+    ok.

+ 1 - 1
src/gproc_app.erl

@@ -21,7 +21,7 @@
 %%          {error, Reason}
 %%          {error, Reason}
 %%----------------------------------------------------------------------
 %%----------------------------------------------------------------------
 start() ->
 start() ->
-    start(xxxwhocares, []).
+    start(normal, []).
 
 
 start(_Type, StartArgs) ->
 start(_Type, StartArgs) ->
     case gproc_sup:start_link(StartArgs) of
     case gproc_sup:start_link(StartArgs) of

+ 55 - 30
src/gproc_lib.erl

@@ -31,10 +31,12 @@
 %% Pid around as payload as well. This is a bit redundant, but
 %% Pid around as payload as well. This is a bit redundant, but
 %% symmetric.
 %% symmetric.
 %%
 %%
-insert_reg({T,_,Name} = K, Value, Pid, C) when T==a; T==n ->
+-spec insert_reg(key(), any(), pid(), scope()) -> boolean().
+
+insert_reg({T,_,Name} = K, Value, Pid, Scope) when T==a; T==n ->
     MaybeScan = fun() ->
     MaybeScan = fun() ->
                         if T==a ->
                         if T==a ->
-                                Initial = scan_existing_counters(C, Name),
+                                Initial = scan_existing_counters(Scope, Name),
                                 ets:insert(?TAB, {{K,a}, Pid, Initial});
                                 ets:insert(?TAB, {{K,a}, Pid, Initial});
                            true ->
                            true ->
                                 true
                                 true
@@ -51,48 +53,67 @@ insert_reg({T,_,Name} = K, Value, Pid, C) when T==a; T==n ->
                     false
                     false
             end
             end
     end;
     end;
-insert_reg({c,C,Ctr} = Key, Value, Pid, _C) when C==l; C==g ->
+insert_reg({c,Scope,Ctr} = Key, Value, Pid, Scope) when Scope==l; Scope==g ->
     %% Non-unique keys; store Pid in the key part
     %% Non-unique keys; store Pid in the key part
     K = {Key, Pid},
     K = {Key, Pid},
     Kr = {Pid, Key},
     Kr = {Pid, Key},
     Res = ets:insert_new(?TAB, [{K, Pid, Value}, {Kr,r}]),
     Res = ets:insert_new(?TAB, [{K, Pid, Value}, {Kr,r}]),
-    update_aggr_counter(g, Ctr, Value),
+    case Res of
+        true ->
+            update_aggr_counter(Scope, Ctr, Value);
+        false ->
+            ignore
+    end,
     Res;
     Res;
-insert_reg(Key, Value, Pid, _C) ->
+insert_reg(Key, Value, Pid, _Scope) ->
     %% Non-unique keys; store Pid in the key part
     %% Non-unique keys; store Pid in the key part
     K = {Key, Pid},
     K = {Key, Pid},
     Kr = {Pid, Key},
     Kr = {Pid, Key},
     ets:insert_new(?TAB, [{K, Pid, Value}, {Kr,r}]).
     ets:insert_new(?TAB, [{K, Pid, Value}, {Kr,r}]).
 
 
-insert_many(T, C, KVL, Pid) ->
-    Objs = mk_reg_objs(T, C, Pid, KVL),
+
+
+-spec insert_many(type(), scope(), [{key(),any()}], pid()) ->
+          {true,list()} | false.
+
+insert_many(T, Scope, KVL, Pid) ->
+    Objs = mk_reg_objs(T, Scope, Pid, KVL),
     case ets:insert_new(?TAB, Objs) of
     case ets:insert_new(?TAB, Objs) of
         true ->
         true ->
-            RevObjs = mk_reg_rev_objs(T, C, Pid, KVL),
+            RevObjs = mk_reg_rev_objs(T, Scope, Pid, KVL),
             ets:insert(?TAB, RevObjs),
             ets:insert(?TAB, RevObjs),
+	    gproc_lib:ensure_monitor(Pid, Scope),
             {true, Objs};
             {true, Objs};
         false ->
         false ->
             Existing = [{Obj, ets:lookup(?TAB, K)} || {K,_,_} = Obj <- Objs],
             Existing = [{Obj, ets:lookup(?TAB, K)} || {K,_,_} = Obj <- Objs],
-            case lists:any(fun({_, [{_,L}]}) -> is_list(L);
-                              (_) -> false
+            case lists:any(fun({_, [{_, _, _}]}) ->
+                                   true;
+                              (_) ->
+                                   %% (not found), or waiters registered
+                                   false
                            end, Existing) of
                            end, Existing) of
-                [_|_] ->
-                    insert_objects(Existing);
-                [] ->
-                    false
+                true ->
+                    %% conflict; return 'false', indicating failure
+                    false;
+                false ->
+                    %% possibly waiters, but they are handled in next step
+                    insert_objects(Existing),
+		    gproc_lib:ensure_monitor(Pid, Scope),
+                    {true, Objs}
             end
             end
     end.
     end.
 
 
+-spec insert_objects([{key(), pid(), any()}]) -> ok.
+     
 insert_objects(Objs) ->
 insert_objects(Objs) ->
-    lists:map(
-      fun({{K, Pid, V} = Obj, Existing}) ->
-              ets:insert(?TAB, [Obj, {{Pid, K}, r}]),
+    lists:foreach(
+      fun({{{Id,_} = K, Pid, V} = Obj, Existing}) ->
+              ets:insert(?TAB, [Obj, {{Pid, Id}, r}]),
               case Existing of
               case Existing of
                   [] -> ok;
                   [] -> ok;
                   [{_, Waiters}] ->
                   [{_, Waiters}] ->
-                      notify_waiters(Waiters, K, Pid, V)
-              end,
-              Obj
+                      notify_waiters(Waiters, Id, Pid, V)
+              end
       end, Objs).
       end, Objs).
 
 
 
 
@@ -129,33 +150,37 @@ maybe_waiters(K, Pid, Value, T, Info) ->
             false
             false
     end.
     end.
 
 
+
+-spec notify_waiters([{pid(), reference()}], key(), pid(), any()) -> ok.
+
 notify_waiters(Waiters, K, Pid, V) ->
 notify_waiters(Waiters, K, Pid, V) ->
     [begin
     [begin
          P ! {gproc, Ref, registered, {K, Pid, V}},
          P ! {gproc, Ref, registered, {K, Pid, V}},
-         ets:delete(?TAB, {P,K}) 
-     end || {P, Ref} <- Waiters].
+         ets:delete(?TAB, {P, K}) 
+     end || {P, Ref} <- Waiters],
+    ok.
 
 
 
 
 
 
-mk_reg_objs(T, C, _, L) when T==n; T==a ->
+mk_reg_objs(T, Scope, Pid, L) when T==n; T==a ->
     lists:map(fun({K,V}) ->
     lists:map(fun({K,V}) ->
-                      {{{T,C,K},T}, V};
+                      {{{T,Scope,K},T}, Pid, V};
                  (_) ->
                  (_) ->
                       erlang:error(badarg)
                       erlang:error(badarg)
               end, L);
               end, L);
-mk_reg_objs(p = T, C, Pid, L) ->
+mk_reg_objs(p = T, Scope, Pid, L) ->
     lists:map(fun({K,V}) ->
     lists:map(fun({K,V}) ->
-                      {{{T,C,K},Pid}, V};
+                      {{{T,Scope,K},Pid}, Pid, V};
                  (_) ->
                  (_) ->
                       erlang:error(badarg)
                       erlang:error(badarg)
               end, L).
               end, L).
 
 
-mk_reg_rev_objs(T, C, Pid, L) ->
-    [{{Pid,{T,C,K}},r} || {K,_} <- L].
+mk_reg_rev_objs(T, Scope, Pid, L) ->
+    [{{Pid,{T,Scope,K}},r} || {K,_} <- L].
 
 
 
 
-ensure_monitor(Pid,C) when C==g; C==l ->
-    case node(Pid) == node() andalso ets:insert_new(?TAB, {{Pid,C}}) of
+ensure_monitor(Pid, Scope) when Scope==g; Scope==l ->
+    case node(Pid) == node() andalso ets:insert_new(?TAB, {{Pid, Scope}}) of
         false -> ok;
         false -> ok;
         true  -> erlang:monitor(process, Pid)
         true  -> erlang:monitor(process, Pid)
     end.
     end.