Implement call/3 dirty_timeout

3 files changed, 140 insertions, 48 deletions

diff --git a/lib/stdlib/doc/src/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml
index 3322571b2c..17f1526a21 100644
--- a/lib/stdlib/doc/src/gen_statem.xml
+++ b/lib/stdlib/doc/src/gen_statem.xml
@@ -919,18 +919,40 @@ handle_event(_, _, State, Data) ->
 	</p>
 	<note>
 	  <p>
-	    For <c><anno>Timeout</anno> =/= infinity</c>,
+	    For <c><anno>Timeout</anno> &lt; infinity</c>,
 	    to avoid getting a late reply in the caller's
-	    inbox, this function spawns a proxy process that
+	    inbox if the caller should catch exceptions,
+	    this function spawns a proxy process that
 	    does the call. A late reply gets delivered to the
 	    dead proxy process, hence gets discarded. This is
 	    less efficient than using
-	    <c><anno>Timeout</anno> =:= infinity</c>.
+	    <c><anno>Timeout</anno> == infinity</c>.
 	  </p>
 	</note>
 	<p>
-	  The call can fail, for example, if the <c>gen_statem</c> dies
-	  before or during this function call.
+	  <c><anno>Timeout</anno></c> can also be a tuple
+	  <c>{clean_timeout,<anno>T</anno>}</c> or
+	  <c>{dirty_timeout,<anno>T</anno>}</c>, where
+	  <c><anno>T</anno></c> is the timeout time.
+	  <c>{clean_timeout,<anno>T</anno>}</c> works like
+	  just <c>T</c> described in the note above
+	  and uses a proxy process for <c>T &lt; infinity</c>,
+	  while <c>{dirty_timeout,<anno>T</anno>}</c>
+	  bypasses the proxy process which is more lightweight.
+	</p>
+	<note>
+	  <p>
+	    If you combine catching exceptions from this function
+	    with <c>{dirty_timeout,<anno>T</anno>}</c>
+	    to avoid that the calling process dies when the call
+	    times out, you will have to be prepared to handle
+	    a late reply.
+	    So why not just allow the calling process to die?
+	  </p>
+	</note>
+	<p>
+	  The call can also fail, for example, if the <c>gen_statem</c>
+	  dies before or during this function call.
 	</p>
       </desc>
     </func>
diff --git a/lib/stdlib/src/gen_statem.erl b/lib/stdlib/src/gen_statem.erl
index 3b3477b282..46c0e92a9b 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -385,53 +385,79 @@ call(ServerRef, Request) ->
 -spec call(
 	ServerRef :: server_ref(),
 	Request :: term(),
-	Timeout :: timeout()) ->
+	Timeout ::
+	  timeout() |
+	  {'clean_timeout',T :: timeout()} |
+	  {'dirty_timeout',T :: timeout()}) ->
 		  Reply :: term().
-call(ServerRef, Request, infinity) ->
-    try gen:call(ServerRef, '$gen_call', Request, infinity) of
-	{ok,Reply} ->
-	    Reply
-    catch
-	Class:Reason ->
-	    erlang:raise(
-	      Class,
-	      {Reason,{?MODULE,call,[ServerRef,Request,infinity]}},
-	      erlang:get_stacktrace())
-    end;
 call(ServerRef, Request, Timeout) ->
-    %% Call server through proxy process to dodge any late reply
-    Ref = make_ref(),
-    Self = self(),
-    Pid = spawn(
-	    fun () ->
-		    Self !
-			try gen:call(
-			      ServerRef, '$gen_call', Request, Timeout) of
-			    Result ->
-				{Ref,Result}
-			catch Class:Reason ->
-				{Ref,Class,Reason,erlang:get_stacktrace()}
-			end
-	    end),
-    Mref = monitor(process, Pid),
-    receive
-	{Ref,Result} ->
-	    demonitor(Mref, [flush]),
-	    case Result of
+    case parse_timeout(Timeout) of
+	{dirty_timeout,T} ->
+	    try gen:call(ServerRef, '$gen_call', Request, T) of
 		{ok,Reply} ->
 		    Reply
+	    catch
+		Class:Reason ->
+		    erlang:raise(
+		      Class,
+		      {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}},
+		      erlang:get_stacktrace())
+	    end;
+	{clean_timeout,T} ->
+	    %% Call server through proxy process to dodge any late reply
+	    Ref = make_ref(),
+	    Self = self(),
+	    Pid = spawn(
+		    fun () ->
+			    Self !
+				try gen:call(
+				      ServerRef, '$gen_call', Request, T) of
+				    Result ->
+					{Ref,Result}
+				catch Class:Reason ->
+					{Ref,Class,Reason,
+					 erlang:get_stacktrace()}
+				end
+		    end),
+	    Mref = monitor(process, Pid),
+	    receive
+		{Ref,Result} ->
+		    demonitor(Mref, [flush]),
+		    case Result of
+			{ok,Reply} ->
+			    Reply
+		    end;
+		{Ref,Class,Reason,Stacktrace} ->
+		    demonitor(Mref, [flush]),
+		    erlang:raise(
+		      Class,
+		      {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}},
+		      Stacktrace);
+		{'DOWN',Mref,_,_,Reason} ->
+		    %% There is a theoretical possibility that the
+		    %% proxy process gets killed between try--of and !
+		    %% so this clause is in case of that
+		    exit(Reason)
 	    end;
-	{Ref,Class,Reason,Stacktrace} ->
-	    demonitor(Mref, [flush]),
-	    erlang:raise(
-	      Class,
-	      {Reason,{?MODULE,call,[ServerRef,Request,Timeout]}},
-	      Stacktrace);
-	{'DOWN',Mref,_,_,Reason} ->
-	    %% There is a theoretical possibility that the
-	    %% proxy process gets killed between try--of and !
-	    %% so this clause is in case of that
-	    exit(Reason)
+	Error when is_atom(Error) ->
+	    erlang:error(Error, [ServerRef,Request,Timeout])
+    end.
+
+parse_timeout(Timeout) ->
+    case Timeout of
+	{clean_timeout,infinity} ->
+	    {dirty_timeout,infinity};
+	{clean_timeout,_} ->
+	    Timeout;
+	{dirty_timeout,_} ->
+	    Timeout;
+	{_,_} ->
+	    %% Be nice and throw a badarg for speling errors
+	    badarg;
+	infinity ->
+	    {dirty_timeout,infinity};
+	T ->
+	    {clean_timeout,T}
     end.
 
 %% Reply from a state machine callback to whom awaits in call/2
diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl
index 1d1417c2e6..e092940174 100644
--- a/lib/stdlib/test/gen_statem_SUITE.erl
+++ b/lib/stdlib/test/gen_statem_SUITE.erl
@@ -57,7 +57,7 @@ tcs(start) ->
 tcs(stop) ->
     [stop1, stop2, stop3, stop4, stop5, stop6, stop7, stop8, stop9, stop10];
 tcs(abnormal) ->
-    [abnormal1, abnormal2];
+    [abnormal1, abnormal1clean, abnormal1dirty, abnormal2];
 tcs(sys) ->
     [sys1, call_format_status,
      error_format_status, terminate_crash_format,
@@ -451,8 +451,52 @@ abnormal1(Config) ->
 	   gen_statem:call(Name, {delayed_answer,1000}, 10),
 	   Reason),
     ok = gen_statem:stop(Name),
+    ?t:sleep(1100),
     ok = verify_empty_msgq().
 
+%% Check that time outs in calls work
+abnormal1clean(Config) ->
+    Name = abnormal1clean,
+    LocalSTM = {local,Name},
+
+    {ok, _Pid} =
+	gen_statem:start(LocalSTM, ?MODULE, start_arg(Config, []), []),
+
+    %% timeout call.
+    delayed =
+	gen_statem:call(Name, {delayed_answer,1}, {clean_timeout,100}),
+    {timeout,_} =
+	?EXPECT_FAILURE(
+	   gen_statem:call(
+	     Name, {delayed_answer,1000}, {clean_timeout,10}),
+	   Reason),
+    ok = gen_statem:stop(Name),
+    ?t:sleep(1100),
+    ok = verify_empty_msgq().
+
+%% Check that time outs in calls work
+abnormal1dirty(Config) ->
+    Name = abnormal1dirty,
+    LocalSTM = {local,Name},
+
+    {ok, _Pid} =
+	gen_statem:start(LocalSTM, ?MODULE, start_arg(Config, []), []),
+
+    %% timeout call.
+    delayed =
+	gen_statem:call(Name, {delayed_answer,1}, {dirty_timeout,100}),
+    {timeout,_} =
+	?EXPECT_FAILURE(
+	   gen_statem:call(
+	     Name, {delayed_answer,1000}, {dirty_timeout,10}),
+	   Reason),
+    ok = gen_statem:stop(Name),
+    ?t:sleep(1100),
+    case flush() of
+	[{Ref,delayed}] when is_reference(Ref) ->
+	    ok
+    end.
+
 %% Check that bad return values makes the stm crash. Note that we must
 %% trap exit since we must link to get the real bad_return_ error
 abnormal2(Config) ->