Merge tag 'OTP-19.0' into sverker/19/binary_to_atom-utf8-crash/ERL-474/OTP-14590

1 files changed, 174 insertions, 83 deletions

diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl
index 7281549ea7..597830cf9a 100644
--- a/lib/stdlib/src/gen.erl
+++ b/lib/stdlib/src/gen.erl
@@ -1,18 +1,19 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 1996-2013. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
 %%
-%% The contents of this file are subject to the Erlang Public License,
-%% Version 1.1, (the "License"); you may not use this file except in
-%% compliance with the License. You should have received a copy of the
-%% Erlang Public License along with this software. If not, it can be
-%% retrieved online at http://www.erlang.org/.
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
 %%
-%% Software distributed under the License is distributed on an "AS IS"
-%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
-%% the License for the specific language governing rights and limitations
-%% under the License.
+%%     http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
 %%
 %% %CopyrightEnd%
 %%
@@ -25,8 +26,9 @@
 %%%
 %%% The standard behaviour should export init_it/6.
 %%%-----------------------------------------------------------------
--export([start/5, start/6, debug_options/1,
-	 call/3, call/4, reply/2]).
+-export([start/5, start/6, debug_options/2,
+	 name/1, unregister_name/1, get_proc_name/1, get_parent/0,
+	 call/3, call/4, reply/2, stop/1, stop/3]).
 
 -export([init_it/6, init_it/7]).
 
@@ -37,7 +39,9 @@
 %%-----------------------------------------------------------------
 
 -type linkage()    :: 'link' | 'nolink'.
--type emgr_name()  :: {'local', atom()} | {'global', term()} | {via, atom(), term()}.
+-type emgr_name()  :: {'local', atom()}
+                    | {'global', term()}
+                    | {'via', Module :: module(), Name :: term()}.
 
 -type start_ret()  :: {'ok', pid()} | 'ignore' | {'error', term()}.
 
@@ -121,7 +125,7 @@ init_it(GenMod, Starter, Parent, Mod, Args, Options) ->
     init_it2(GenMod, Starter, Parent, self(), Mod, Args, Options).
 
 init_it(GenMod, Starter, Parent, Name, Mod, Args, Options) ->
-    case name_register(Name) of
+    case register_name(Name) of
 	true ->
 	    init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options);
 	{false, Pid} ->
@@ -143,56 +147,10 @@ init_it2(GenMod, Starter, Parent, Name, Mod, Args, Options) ->
 call(Process, Label, Request) -> 
     call(Process, Label, Request, ?default_timeout).
 
-%% Local or remote by pid
-call(Pid, Label, Request, Timeout) 
-  when is_pid(Pid), Timeout =:= infinity;
-       is_pid(Pid), is_integer(Timeout), Timeout >= 0 ->
-    do_call(Pid, Label, Request, Timeout);
-%% Local by name
-call(Name, Label, Request, Timeout) 
-  when is_atom(Name), Timeout =:= infinity;
-       is_atom(Name), is_integer(Timeout), Timeout >= 0 ->
-    case whereis(Name) of
-	Pid when is_pid(Pid) ->
-	    do_call(Pid, Label, Request, Timeout);
-	undefined ->
-	    exit(noproc)
-    end;
-%% Global by name
 call(Process, Label, Request, Timeout)
-  when ((tuple_size(Process) == 2 andalso element(1, Process) == global)
-	orelse
-	  (tuple_size(Process) == 3 andalso element(1, Process) == via))
-       andalso
-       (Timeout =:= infinity orelse (is_integer(Timeout) andalso Timeout >= 0)) ->
-    case where(Process) of
-	Pid when is_pid(Pid) ->
-	    Node = node(Pid),
- 	    try do_call(Pid, Label, Request, Timeout)
- 	    catch
- 		exit:{nodedown, Node} ->
- 		    %% A nodedown not yet detected by global,
- 		    %% pretend that it was.
- 		    exit(noproc)
-	    end;
-	undefined ->
-	    exit(noproc)
-    end;
-%% Local by name in disguise
-call({Name, Node}, Label, Request, Timeout)
-  when Node =:= node(), Timeout =:= infinity;
-       Node =:= node(), is_integer(Timeout), Timeout >= 0 ->
-    call(Name, Label, Request, Timeout);
-%% Remote by name
-call({_Name, Node}=Process, Label, Request, Timeout)
-  when is_atom(Node), Timeout =:= infinity;
-       is_atom(Node), is_integer(Timeout), Timeout >= 0 ->
-    if
- 	node() =:= nonode@nohost ->
- 	    exit({nodedown, Node});
- 	true ->
- 	    do_call(Process, Label, Request, Timeout)
-    end.
+  when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 ->
+    Fun = fun(Pid) -> do_call(Pid, Label, Request, Timeout) end,
+    do_for_proc(Process, Fun).
 
 do_call(Process, Label, Request, Timeout) ->
     try erlang:monitor(process, Process) of
@@ -274,6 +232,65 @@ reply({To, Tag}, Reply) ->
     Msg = {Tag, Reply},
     try To ! Msg catch _:_ -> Msg end.
 
+%%-----------------------------------------------------------------
+%% Syncronously stop a generic process
+%%-----------------------------------------------------------------
+stop(Process) ->
+    stop(Process, normal, infinity).
+
+stop(Process, Reason, Timeout)
+  when Timeout =:= infinity; is_integer(Timeout), Timeout >= 0 ->
+    Fun = fun(Pid) -> proc_lib:stop(Pid, Reason, Timeout) end,
+    do_for_proc(Process, Fun).
+
+%%-----------------------------------------------------------------
+%% Map different specifications of a process to either Pid or
+%% {Name,Node}. Execute the given Fun with the process as only
+%% argument.
+%% -----------------------------------------------------------------
+
+%% Local or remote by pid
+do_for_proc(Pid, Fun) when is_pid(Pid) ->
+    Fun(Pid);
+%% Local by name
+do_for_proc(Name, Fun) when is_atom(Name) ->
+    case whereis(Name) of
+	Pid when is_pid(Pid) ->
+	    Fun(Pid);
+	undefined ->
+	    exit(noproc)
+    end;
+%% Global by name
+do_for_proc(Process, Fun)
+  when ((tuple_size(Process) == 2 andalso element(1, Process) == global)
+	orelse
+	  (tuple_size(Process) == 3 andalso element(1, Process) == via)) ->
+    case where(Process) of
+	Pid when is_pid(Pid) ->
+	    Node = node(Pid),
+	    try Fun(Pid)
+	    catch
+		exit:{nodedown, Node} ->
+		    %% A nodedown not yet detected by global,
+		    %% pretend that it was.
+		    exit(noproc)
+	    end;
+	undefined ->
+	    exit(noproc)
+    end;
+%% Local by name in disguise
+do_for_proc({Name, Node}, Fun) when Node =:= node() ->
+    do_for_proc(Name, Fun);
+%% Remote by name
+do_for_proc({_Name, Node} = Process, Fun) when is_atom(Node) ->
+    if
+	node() =:= nonode@nohost ->
+	    exit({nodedown, Node});
+	true ->
+	    Fun(Process)
+    end.
+
+
 %%%-----------------------------------------------------------------
 %%%  Misc. functions.
 %%%-----------------------------------------------------------------
@@ -281,19 +298,19 @@ where({global, Name}) -> global:whereis_name(Name);
 where({via, Module, Name}) -> Module:whereis_name(Name);
 where({local, Name})  -> whereis(Name).
 
-name_register({local, Name} = LN) ->
+register_name({local, Name} = LN) ->
     try register(Name, self()) of
 	true -> true
     catch
 	error:_ ->
 	    {false, where(LN)}
     end;
-name_register({global, Name} = GN) ->
+register_name({global, Name} = GN) ->
     case global:register_name(Name, self()) of
 	yes -> true;
 	no -> {false, where(GN)}
     end;
-name_register({via, Module, Name} = GN) ->
+register_name({via, Module, Name} = GN) ->
     case Module:register_name(Name, self()) of
 	yes ->
 	    true;
@@ -301,34 +318,108 @@ name_register({via, Module, Name} = GN) ->
 	    {false, where(GN)}
     end.
 
+name({local,Name}) -> Name;
+name({global,Name}) -> Name;
+name({via,_, Name}) -> Name;
+name(Pid) when is_pid(Pid) -> Pid.
+
+unregister_name({local,Name}) ->
+    try unregister(Name) of
+	_ -> ok
+    catch
+	_:_ -> ok
+    end;
+unregister_name({global,Name}) ->
+    _ = global:unregister_name(Name),
+    ok;
+unregister_name({via, Mod, Name}) ->
+    _ = Mod:unregister_name(Name),
+    ok;
+unregister_name(Pid) when is_pid(Pid) ->
+    ok.
+
+get_proc_name(Pid) when is_pid(Pid) ->
+    Pid;
+get_proc_name({local, Name}) ->
+    case process_info(self(), registered_name) of
+	{registered_name, Name} ->
+	    Name;
+	{registered_name, _Name} ->
+	    exit(process_not_registered);
+	[] ->
+	    exit(process_not_registered)
+    end;
+get_proc_name({global, Name}) ->
+    case global:whereis_name(Name) of
+	undefined ->
+	    exit(process_not_registered_globally);
+	Pid when Pid =:= self() ->
+	    Name;
+	_Pid ->
+	    exit(process_not_registered_globally)
+    end;
+get_proc_name({via, Mod, Name}) ->
+    case Mod:whereis_name(Name) of
+	undefined ->
+	    exit({process_not_registered_via, Mod});
+	Pid when Pid =:= self() ->
+	    Name;
+	_Pid ->
+	    exit({process_not_registered_via, Mod})
+    end.
+
+get_parent() ->
+    case get('$ancestors') of
+	[Parent | _] when is_pid(Parent) ->
+	    Parent;
+	[Parent | _] when is_atom(Parent) ->
+	    name_to_pid(Parent);
+	_ ->
+	    exit(process_was_not_started_by_proc_lib)
+    end.
+
+name_to_pid(Name) ->
+    case whereis(Name) of
+	undefined ->
+	    case global:whereis_name(Name) of
+		undefined ->
+		    exit(could_not_find_registered_name);
+		Pid ->
+		    Pid
+	    end;
+	Pid ->
+	    Pid
+    end.
+
 
 timeout(Options) ->
-    case opt(timeout, Options) of
-	{ok, Time} ->
+    case lists:keyfind(timeout, 1, Options) of
+	{_,Time} ->
 	    Time;
-	_ ->
+	false ->
 	    infinity
     end.
 
 spawn_opts(Options) ->
-    case opt(spawn_opt, Options) of
-	{ok, Opts} ->
+    case lists:keyfind(spawn_opt, 1, Options) of
+	{_,Opts} ->
 	    Opts;
-	_ ->
+	false ->
 	    []
     end.
 
-opt(Op, [{Op, Value}|_]) ->
-    {ok, Value};
-opt(Op, [_|Options]) ->
-    opt(Op, Options);
-opt(_, []) ->
-    false.
-
-debug_options(Opts) ->
-    case opt(debug, Opts) of
-	{ok, Options} -> sys:debug_options(Options);
-	_ -> []
+debug_options(Name, Opts) ->
+    case lists:keyfind(debug, 1, Opts) of
+	{_,Options} ->
+	    try sys:debug_options(Options)
+	    catch _:_ ->
+		    error_logger:format(
+		      "~p: ignoring erroneous debug options - ~p~n",
+		      [Name,Options]),
+		    []
+	    end;
+	false ->
+	    []
     end.
 
 format_status_header(TagLine, Pid) when is_pid(Pid) ->