Avoid deadlock when an on_load function makes an external call to the module itself

2 files changed, 50 insertions, 15 deletions

diff --git a/lib/kernel/src/code_server.erl b/lib/kernel/src/code_server.erl
index 356c6630fa..10264382eb 100644
--- a/lib/kernel/src/code_server.erl
+++ b/lib/kernel/src/code_server.erl
@@ -32,7 +32,8 @@
 
 -import(lists, [foreach/2]).
 
--type on_load_item() :: {reference(),module(),file:name_all(),[pid()]}.
+-type on_load_item() :: {{pid(),reference()},module(),
+			 file:name_all(),[pid()]}.
 
 -record(state, {supervisor :: pid(),
 		root :: file:name_all(),
@@ -155,8 +156,8 @@ loop(#state{supervisor=Supervisor}=State0) ->
 	    system_terminate(Reason, Supervisor, [], State0);
 	{system, From, Msg} ->
 	    handle_system_msg(running,Msg, From, Supervisor, State0);
-	{'DOWN',Ref,process,_,Res} ->
-	    State = finish_on_load(Ref, Res, State0),
+	{'DOWN',Ref,process,Pid,Res} ->
+	    State = finish_on_load({Pid,Ref}, Res, State0),
 	    loop(State);
 	_Msg ->
 	    loop(State0)
@@ -1312,38 +1313,46 @@ handle_on_load(Mod, File, From, #state{on_load=OnLoad0}=St0) ->
 		  Res = erlang:call_on_load_function(Mod),
 		  exit(Res)
 	  end,
-    {_,Ref} = spawn_monitor(Fun),
-    OnLoad = [{Ref,Mod,File,[From]}|OnLoad0],
+    PidRef = spawn_monitor(Fun),
+    OnLoad = [{PidRef,Mod,File,[From]}|OnLoad0],
     St = St0#state{on_load=OnLoad},
     {noreply,St}.
 
 pending_on_load(_, _, #state{on_load=[]}) ->
     no;
 pending_on_load(Mod, From, #state{on_load=OnLoad0}=St) ->
-    case lists:keymember(Mod, 2, OnLoad0) of
+    case lists:keyfind(Mod, 2, OnLoad0) of
 	false ->
 	    no;
-	true ->
+	{{From,_Ref},Mod,_File,_Pids} ->
+	    %% The on_load function tried to make an external
+	    %% call to its own module. That would be a deadlock.
+	    %% Fail the call. (The call is probably from error_handler,
+	    %% and it will ignore the actual error reason and cause
+	    %% an undef execption.)
+	    _ = reply(From, {error,deadlock}),
+	    {yes,St};
+	{_,_,_,_} ->
 	    OnLoad = pending_on_load_1(Mod, From, OnLoad0),
 	    {yes,St#state{on_load=OnLoad}}
     end.
 
-pending_on_load_1(Mod, From, [{Ref,Mod,File,Pids}|T]) ->
-    [{Ref,Mod,File,[From|Pids]}|T];
+pending_on_load_1(Mod, From, [{PidRef,Mod,File,Pids}|T]) ->
+    [{PidRef,Mod,File,[From|Pids]}|T];
 pending_on_load_1(Mod, From, [H|T]) ->
     [H|pending_on_load_1(Mod, From, T)];
 pending_on_load_1(_, _, []) -> [].
 
-finish_on_load(Ref, OnLoadRes, #state{on_load=OnLoad0,moddb=Db}=State) ->
-    case lists:keyfind(Ref, 1, OnLoad0) of
+finish_on_load(PidRef, OnLoadRes, #state{on_load=OnLoad0,moddb=Db}=State) ->
+    case lists:keyfind(PidRef, 1, OnLoad0) of
 	false ->
 	    %% Since this process in general silently ignores messages
 	    %% it doesn't understand, it should also ignore a 'DOWN'
 	    %% message with an unknown reference.
 	    State;
-	{Ref,Mod,File,WaitingPids} ->
+	{PidRef,Mod,File,WaitingPids} ->
 	    finish_on_load_1(Mod, File, OnLoadRes, WaitingPids, Db),
-	    OnLoad = [E || {R,_,_,_}=E <- OnLoad0, R =/= Ref],
+	    OnLoad = [E || {R,_,_,_}=E <- OnLoad0, R =/= PidRef],
 	    State#state{on_load=OnLoad}
     end.
 
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index 547881f3b2..e238eea2de 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -35,7 +35,7 @@
 	 purge_stacktrace/1, mult_lib_roots/1, bad_erl_libs/1,
 	 code_archive/1, code_archive2/1, on_load/1, on_load_binary/1,
 	 on_load_embedded/1, on_load_errors/1, on_load_update/1,
-	 on_load_purge/1,
+	 on_load_purge/1, on_load_self_call/1,
 	 big_boot_embedded/1,
 	 native_early_modules/1, get_mode/1,
 	 normalized_paths/1]).
@@ -65,7 +65,7 @@ all() ->
      purge_stacktrace, mult_lib_roots,
      bad_erl_libs, code_archive, code_archive2, on_load,
      on_load_binary, on_load_embedded, on_load_errors, on_load_update,
-     on_load_purge,
+     on_load_purge, on_load_self_call,
      big_boot_embedded, native_early_modules, get_mode, normalized_paths].
 
 groups() ->
@@ -1523,6 +1523,32 @@ on_load_purge(_Config) ->
 	    end
     end.
 
+on_load_self_call(_Config) ->
+    Mod = ?FUNCTION_NAME,
+    register(Mod, self()),
+    Tree = ?Q(["-module('@Mod@').\n",
+	       "-export([ext/0]).\n",
+	       "-on_load(f/0).\n",
+	       "f() ->\n",
+	       "  '@Mod@' ! (catch '@Mod@':ext()),\n",
+	       "  ok.\n",
+	       "ext() -> good_work.\n"]),
+        merl:print(Tree),
+    {ok,Mod,Code} = merl:compile(Tree),
+
+    {'EXIT',{undef,_}} = on_load_do_load(Mod, Code),
+    good_work = on_load_do_load(Mod, Code),
+
+    ok.
+
+on_load_do_load(Mod, Code) ->
+    spawn(fun() ->
+		  {module,Mod} = code:load_binary(Mod, "", Code)
+	  end),
+    receive
+	Any -> Any
+    end.
+
 %% Test that the native code of early loaded modules is loaded.
 native_early_modules(Config) when is_list(Config) ->
     case erlang:system_info(hipe_architecture) of