tested local gproc

git-svn-id: http://svn.ulf.wiger.net/gproc/branches/experimental-0906/gproc@18 f3948e33-8234-0410-8a80-a07eae3b6c4d

src/Makefile

@@ -0,0 +1,53 @@
+## The MIT License
+##
+## Copyright (c) 2008 Ulf Wiger <ulf@wiger.net>,
+##
+## Permission is hereby granted, free of charge, to any person obtaining a
+## copy of this software and associated documentation files (the "Software"),
+## to deal in the Software without restriction, including without limitation
+## the rights to use, copy, modify, merge, publish, distribute, sublicense,
+## and/or sell copies of the Software, and to permit persons to whom the
+## Software is furnished to do so, subject to the following conditions:
+##
+## The above copyright notice and this permission notice shall be included in
+## all copies or substantial portions of the Software.
+##
+## THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+## IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+## FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+## THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+## LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 
+## FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+## DEALINGS IN THE SOFTWARE.
+
+
+.SUFFIXES: .erl .beam
+
+vpath %.beam ../ebin
+vpath %.pdf ../doc
+
+ERLC = erlc -W -o ../ebin +debug_info
+EQC = /host/dev/eqc-1.16/ebin
+ERL_EQC = erl -pz ../ebin -pz $(EQC) -kernel error_logger silent
+
+beams = gproc.beam \
+	gproc_app.beam \
+	gproc_dist.beam \
+	gproc_lib.beam \
+	gproc_sup.beam
+
+all : $(beams)
+test : all gproc_eqc.beam
+	$(ERL_EQC) -s gproc_eqc run
+
+itest : all gproc_eqc.beam
+	$(ERL_EQC) -s eqc start
+
+clean :
+	rm -f *~ #*# 
+
+$(beams) : %.beam : %.erl
+	$(ERLC) $<
+
+gproc_eqc.beam : gproc_eqc.erl
+	$(ERLC) -pz $(EQC) gproc_eqc.erl

src/gproc.erl

@@ -27,6 +27,9 @@
 	 mreg/3,
 	 set_value/2,
 	 get_value/1,
+	 where/1,
+	 lookup_pid/1,
+	 lookup_pids/1,
 	 update_counter/2,
 	 send/2,
 	 info/1, info/2,
@@ -82,7 +85,7 @@ reg({T,l,_} = Key, Value) when T==n; T==a ->
 reg({c,l,_} = Key, Value) ->
     %% local counter
     if is_integer(Value) ->
-	    local_reg(Key, Value);
+	    call({reg, Key, Value});
        true ->
 	    erlang:error(badarg)
     end;
@@ -194,6 +197,36 @@ get_value(_, _) ->
     erlang:error(badarg).
 
 
+%%% @spec (Key) -> Pid
+%%% @doc Lookup the Pid stored with a key.
+%%%
+lookup_pid({T,_,_} = Key) ->
+    case where(Key) of
+	undefined -> erlang:error(badarg);
+	P -> P
+    end.
+
+
+where({T,_,_}=Key) ->
+    if T==n; T==a ->
+	    case ets:lookup(?TAB, {Key,T}) of
+		[] ->
+		    undefined;
+		[{_, P, _Value}] ->
+		    P
+	    end;
+       true ->
+	    erlang:error(badarg)
+    end.
+
+lookup_pids({T,_,_} = Key) ->
+    if T==n; T==a; T==c ->
+	    ets:select(?TAB, [{{{Key,T}, '$1', '_'},[],['$1']}]);
+       true ->
+	    erlang:error(badarg)
+    end.
+
+
 update_counter({c,l,_} = Key, Incr) when is_integer(Incr) ->
     gproc_lib:update_counter(Key, Incr);
 update_counter({c,g,_} = Key, Incr) when is_integer(Incr) ->
@@ -303,15 +336,15 @@ info(Pid, I) ->
 
 handle_cast({monitor_me, Pid}, S) ->
     erlang:monitor(process, Pid),
-    {ok, S}.
+    {noreply, S}.
 
-handle_call({reg, {_,l,_} = Key, Val}, {Pid,_}, S) ->
-    case gproc_lib:insert_reg(Key, Val, Pid, l) of
-	false ->
-	    {reply, badarg, S};
+handle_call({reg, {T,l,_} = Key, Val}, {Pid,_}, S) ->
+    case try_insert_reg(Key, Val, Pid) of
 	true ->
 	    ensure_monitor(Pid),
-	    {reply, true, S}
+	    {reply, true, S};
+	false ->
+	    {reply, badarg, S}
     end;
 handle_call({unreg, {_,l,_} = Key}, {Pid,_}, S) ->
     case ets:member(?TAB, {Pid,Key}) of
@@ -339,14 +372,10 @@ handle_call(_, _, S) ->
     {reply, badarg, S}.
 
 handle_info({'DOWN', _MRef, process, Pid, _}, S) ->
-    Keys = ets:select(?TAB, [{{{Pid,'$1'}},
-			      [{'==',{element,2,'$1'},l}], ['$1']}]),
-    ets:select_delete(?TAB, [{{{Pid,{'_',l,'_'}}}, [], [true]}]),
-    ets:delete(?TAB, Pid),
-    lists:foreach(fun(Key) -> gproc_lib:remove_reg_1(Key, Pid) end, Keys),
-    {ok, S};
+    process_is_down(Pid),
+    {noreply, S};
 handle_info(_, S) ->
-    {ok, S}.
+    {noreply, S}.
 
 
 
@@ -370,6 +399,30 @@ cast(Msg) ->
 
 
 
+
+try_insert_reg({T,l,_} = Key, Val, Pid) ->
+    case gproc_lib:insert_reg(Key, Val, Pid, l) of
+	false ->
+	    [{_, OtherPid, _}] = ets:lookup(?TAB, {Key,T}),
+	    case is_process_alive(OtherPid) of
+		true ->
+		    false;
+		false ->
+		    process_is_down(Pid),
+		    true = gproc_lib:insert_reg(Key, Val, Pid, l)
+	    end;
+	true ->
+	    true
+    end.
+
+process_is_down(Pid) ->
+    Keys = ets:select(?TAB, [{{{Pid,'$1'}},
+			      [{'==',{element,2,'$1'},l}], ['$1']}]),
+    ets:select_delete(?TAB, [{{{Pid,{'_',l,'_'}}}, [], [true]}]),
+    ets:delete(?TAB, Pid),
+    lists:foreach(fun(Key) -> gproc_lib:remove_reg_1(Key, Pid) end, Keys).
+
+
 create_tabs() ->
     ets:new(?MODULE, [ordered_set, public, named_table]).
 

src/gproc_app.erl

@@ -0,0 +1,43 @@
+%%%----------------------------------------------------------------------
+%%% File     : gproc_app.erl
+%%% Purpose  : GPROC application callback module
+%%%----------------------------------------------------------------------
+
+-module(gproc_app).
+
+-behaviour(application).
+
+%% application callbacks
+-export([start/0, start/2, stop/1]).
+
+%%%----------------------------------------------------------------------
+%%% Callback functions from application
+%%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% Func: start/2
+%% Returns: {ok, Pid}        |
+%%          {ok, Pid, State} |
+%%          {error, Reason}
+%%----------------------------------------------------------------------
+start() ->
+    start(xxxwhocares, []).
+
+start(_Type, StartArgs) ->
+    case gproc_sup:start_link(StartArgs) of
+        {ok, Pid} ->
+            {ok, Pid};
+        Error ->
+            Error
+    end.
+
+%%----------------------------------------------------------------------
+%% Func: stop/1
+%% Returns: any
+%%----------------------------------------------------------------------
+stop(_State) ->
+    ok.
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------

src/gproc_eqc.erl

@@ -0,0 +1,202 @@
+%%% File    : gproc_eqc.erl
+%%% Author  : <Ulf.Wiger@erlang-consulting.com>  
+%%%         : <John.Hughes@quviq.com>
+%%% Description : 
+%%% Created : 11 Dec 2008 by  <John Hughes@JTABLET2007>
+-module(gproc_eqc).
+
+
+-include_lib("eqc/include/eqc.hrl").
+-include_lib("eqc/include/eqc_statem.hrl").
+
+-compile(export_all).
+
+-record(state,{pids=[],regs=[],killed=[]}).
+
+
+run() ->
+%%     eqc:quickcheck(prop_gproc()).
+    run(200).
+
+
+run(Num) ->
+    eqc:quickcheck(eqc:numtests(Num, prop_gproc())).
+
+%% Initialize the state
+initial_state() ->
+    #state{}.
+
+%% Command generator, S is the state
+command(S) ->
+    oneof(
+      [{call,?MODULE,spawn,[]}]++
+      [{call,?MODULE,kill,[elements(S#state.pids)]} || S#state.pids/=[]] ++
+      [{call,?MODULE,reg,[name(),elements(S#state.pids)]}
+       || S#state.pids/=[]] ++
+      [{call,?MODULE,unreg,[elements(S#state.regs)]} || S#state.regs/=[]] ++
+      [{call,gproc,where,[{n,l,name()}]}]			       
+     ).
+
+name() ->
+    elements([a,b,c,d]).
+
+%% Next state transformation, S is the current state
+next_state(S,V,{call,_,spawn,_}) ->
+    S#state{pids=[V|S#state.pids]};
+next_state(S,V,{call,_,kill,[Pid]}) ->
+    S#state{killed=[Pid|S#state.killed],
+	    pids=S#state.pids -- [Pid],
+	    regs = [{Name,Pid2} || {Name,Pid2} <- S#state.regs,
+				   Pid/=Pid2]};
+next_state(S,_V,{call,_,reg,[Name,Pid]}) ->
+    case register_ok(S,Name,Pid) of
+	false ->
+	    S;
+	true ->
+	    S#state{regs=[{Name,Pid}|S#state.regs]}
+    end;
+next_state(S,_V,{call,_,unreg,[{Name,_}]}) ->
+    S#state{regs=lists:keydelete(Name,1,S#state.regs)};
+next_state(S,_V,{call,_,_,_}) ->
+    S.
+
+%% Precondition, checked before command is added to the command sequence
+%% precondition(S,{call,_,unreg,[Name]}) ->
+%%
+%% precondition(S,{call,_,reg,[Name,Pid]}) ->
+%%     
+precondition(_S,{call,_,_,_}) ->
+    true.
+
+unregister_ok(S,Name) ->
+    lists:keymember(Name,1,S#state.regs).
+
+register_ok(S,Name,Pid) ->
+    not lists:keymember(Name,1,S#state.regs).
+
+%% Postcondition, checked after command has been evaluated
+%% OBS: S is the state before next_state(S,_,<command>) 
+postcondition(S,{call,_,where,[{_,_,Name}]},Res) ->
+    Res == proplists:get_value(Name,S#state.regs);
+postcondition(S,{call,_,unreg,[{Name,_}]},Res) ->
+    case Res of
+	true ->
+	    unregister_ok(S,Name);
+	{'EXIT',_} ->
+	    not unregister_ok(S,Name)
+    end;
+postcondition(S,{call,_,reg,[Name,Pid]},Res) ->
+    case Res of
+	true ->
+	    register_ok(S,Name,Pid);
+	{'EXIT',_} ->
+	    not register_ok(S,Name,Pid)
+    end;
+postcondition(_S,{call,_,_,_},_Res) ->
+    true.
+
+prop_gproc() ->
+    ?FORALL(Cmds,commands(?MODULE),
+	    ?TRAPEXIT(
+	    begin
+		ok = start_app(),
+		{H,S,Res} = run_commands(?MODULE,Cmds),
+		kill_all_pids({H,S}),
+		ok = stop_app(),
+		?WHENFAIL(
+		   io:format("History: ~p\nState: ~p\nRes: ~p\n",[H,S,Res]),
+		   Res == ok)
+	    end)).
+
+
+seed() ->
+    noshrink({largeint(),largeint(),largeint()}).
+
+cleanup(Tabs,Server) ->
+    unlink(Server),
+    unlink(Tabs),
+    exit(Server,kill),
+    exit(Tabs,kill),
+    catch unregister(proc_reg),
+    catch unregister(proc_reg_tabs),
+    delete_tables(),
+    ok.%    timer:sleep(1).
+
+start_app() ->
+    case application:start(gproc) of
+	{error, {already_started,_}} ->
+	    stop_app(),
+	    ok = application:start(gproc);
+	ok ->
+	    ok
+    end.
+
+stop_app() ->
+    ok = application:stop(gproc).
+
+
+delete_tables() ->
+    catch ets:delete(proc_reg).
+
+spawn() ->
+    spawn(fun() ->
+		  loop()
+	  end).
+
+loop() ->
+    receive
+	{From, Ref, F} ->
+	    From ! {Ref, catch F()},
+	    loop();
+	stop -> ok
+    end.
+
+do(Pid, F) ->
+    Ref = erlang:monitor(process, Pid),
+    Pid ! {self(), Ref, F},
+    receive
+	{'DOWN', Ref, process, Pid, Reason} ->
+	    {'EXIT', {'DOWN',Reason}};
+	{Ref, Result} ->
+	    erlang:demonitor(Ref),
+	    Result
+    after 3000 ->
+	    {'EXIT', timeout}
+    end.
+
+kill(Pid) ->
+    exit(Pid,foo),
+    timer:sleep(10).
+
+unreg({Name,Pid}) ->
+    do(Pid,
+       fun() ->
+	       catch gproc:unreg({n,l,Name})
+       end).
+
+reg(Name,Pid) ->
+    do(Pid,
+       fun() ->
+	       catch gproc:reg({n,l,Name},Pid)
+       end).
+
+
+%% If using the scheduler...
+%% This code needs to run in a separate module, so it can be compiled
+%% without instrumentation.
+
+kill_all_pids(Pid) when is_pid(Pid) ->
+    case is_process_alive(Pid) of
+	true ->
+	    exit(Pid,kill);
+	false ->
+	    ok
+    end;
+kill_all_pids(Tup) when is_tuple(Tup) ->
+    kill_all_pids(tuple_to_list(Tup));
+kill_all_pids([H|T]) ->
+    kill_all_pids(H),
+    kill_all_pids(T);
+kill_all_pids(_) ->
+    ok.
+

src/gproc_init.erl

@@ -0,0 +1,48 @@
+%%%----------------------------------------------------------------------
+%%% File     : gproc_init.erl
+%%% Purpose  : GPROC init utilities
+%%%----------------------------------------------------------------------
+
+-module(gproc_init).
+
+%% API
+-export([
+         %% soft reset
+         soft_reset/0
+         %% hard reset
+         , hard_reset/0
+        ]).
+
+%%====================================================================
+%% API
+%%====================================================================
+
+%% types
+
+%% soft_reset
+-spec soft_reset() -> ok.
+
+%% hard_reset
+-spec hard_reset() -> ok.
+
+
+%%--------------------------------------------------------------------
+%% soft_reset
+
+soft_reset() ->
+    ok = hard_reset(), %% soft reset isn't enough
+    ok.
+
+%%--------------------------------------------------------------------
+%% hard_reset
+
+hard_reset() ->
+    ok = supervisor:terminate_child(gproc_sup, gproc),
+    [ ets:delete(Tab) || Tab <- ets:all(), Tab =:= gproc ],
+    {ok,_} = supervisor:restart_child(gproc_sup, gproc),
+    ok.
+
+
+%%====================================================================
+%% Internal functions
+%%====================================================================

src/gproc_sup.erl

@@ -0,0 +1,56 @@
+%%%----------------------------------------------------------------------
+%%% File    : gproc_sup.erl
+%%% Purpose : GPROC top-level supervisor
+%%%----------------------------------------------------------------------
+
+-module(gproc_sup).
+
+-behaviour(supervisor).
+
+%% External exports
+-export([start_link/1]).
+
+%% supervisor callbacks
+-export([init/1]).
+
+%%%----------------------------------------------------------------------
+%%% API
+%%%----------------------------------------------------------------------
+start_link(Args) ->
+    supervisor:start_link({local, ?MODULE}, ?MODULE, Args).
+
+%%%----------------------------------------------------------------------
+%%% Callback functions from supervisor
+%%%----------------------------------------------------------------------
+
+%%----------------------------------------------------------------------
+%% Func: init/1
+%% Returns: {ok,  {SupFlags,  [ChildSpec]}} |
+%%          ignore                          |
+%%          {error, Reason}
+%%----------------------------------------------------------------------
+%% @spec(_Args::term()) -> {ok, {supervisor_flags(), child_spec_list()}}
+%% @doc The main GPROC supervisor.
+
+init(_Args) ->
+    %% Hint:
+    %% Child_spec = [Name, {M, F, A},
+    %%               Restart, Shutdown_time, Type, Modules_used]
+
+    GProc =
+        {gproc, {gproc, start_link, []},
+         permanent, 2000, worker, [gproc]},
+    
+    Dist = case application:get_env(gproc_dist) of
+	       undefined -> [];
+	       {ok, false} -> [];
+	       {ok, Env} ->
+		   [{gproc_dist, {gproc_dist, start_link, [Env]},
+		     permanent, 2000, worker, [gproc_dist]}]
+	   end,
+    {ok,{{one_for_one, 15, 60}, [GProc | Dist]}}.
+
+
+%%%----------------------------------------------------------------------
+%%% Internal functions
+%%%----------------------------------------------------------------------