aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stdlib')
-rw-r--r--lib/stdlib/doc/src/io_protocol.xml7
-rw-r--r--lib/stdlib/src/io.erl43
-rw-r--r--lib/stdlib/test/io_SUITE.erl46
3 files changed, 65 insertions, 31 deletions
diff --git a/lib/stdlib/doc/src/io_protocol.xml b/lib/stdlib/doc/src/io_protocol.xml
index 0b76882da4..21da404c35 100644
--- a/lib/stdlib/doc/src/io_protocol.xml
+++ b/lib/stdlib/doc/src/io_protocol.xml
@@ -76,10 +76,11 @@ the server eventually sends a corresponding <c>io_reply</c> tuple.</p>
the I/O server sends the IO reply to.</item>
<item><c>ReplyAs</c> can be any datum and is returned in the corresponding
-<c>io_reply</c>. The <seealso marker="stdlib:io">io</seealso> module simply uses the pid()
-of the I/O server as the <c>ReplyAs</c> datum, but a more complicated client
+<c>io_reply</c>. The <seealso marker="stdlib:io">io</seealso> module monitors
+the I/O server, and uses the monitor reference as the <c>ReplyAs</c> datum.
+A more complicated client
could have several outstanding I/O requests to the same I/O server and
-would then use i.e. a <c>reference()</c> or something else to differentiate among
+would then use different references (or something else) to differentiate among
the incoming IO replies. The <c>ReplyAs</c> element should be considered
opaque by the I/O server. Note that the <c>pid()</c> of the I/O server is not
explicitly present in the <c>io_reply</c> tuple. The reply can be sent from any
diff --git a/lib/stdlib/src/io.erl b/lib/stdlib/src/io.erl
index 27e2a82b41..b9ace2f442 100644
--- a/lib/stdlib/src/io.erl
+++ b/lib/stdlib/src/io.erl
@@ -566,12 +566,23 @@ request(Name, Request) when is_atom(Name) ->
execute_request(Pid, {Convert,Converted}) ->
Mref = erlang:monitor(process, Pid),
- Pid ! {io_request,self(),Pid,Converted},
- if
- Convert ->
- convert_binaries(wait_io_mon_reply(Pid, Mref));
- true ->
- wait_io_mon_reply(Pid, Mref)
+ Pid ! {io_request,self(),Mref,Converted},
+
+ receive
+ {io_reply, Mref, Reply} ->
+ erlang:demonitor(Mref, [flush]),
+ if
+ Convert ->
+ convert_binaries(Reply);
+ true ->
+ Reply
+ end;
+ {'DOWN', Mref, _, _, _} ->
+ receive
+ {'EXIT', Pid, _What} -> true
+ after 0 -> true
+ end,
+ {error,terminated}
end.
requests(Requests) -> %Requests as atomic action
@@ -597,26 +608,6 @@ default_input() ->
default_output() ->
group_leader().
-wait_io_mon_reply(From, Mref) ->
- receive
- {io_reply, From, Reply} ->
- erlang:demonitor(Mref, [flush]),
- Reply;
- {'EXIT', From, _What} ->
- receive
- {'DOWN', Mref, _, _, _} -> true
- after 0 -> true
- end,
- {error,terminated};
- {'DOWN', Mref, _, _, _} ->
- receive
- {'EXIT', From, _What} -> true
- after 0 -> true
- end,
- {error,terminated}
- end.
-
-
%% io_requests(Requests)
%% Transform requests into correct i/o server messages. Only handle the
%% one we KNOW must be changed, others, including incorrect ones, are
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index 3a76275f31..2203dd8f51 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_SUITE.erl
@@ -30,7 +30,8 @@
io_fread_newlines/1, otp_8989/1, io_lib_fread_literal/1,
printable_range/1,
io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1,
- otp_10836/1, io_lib_width_too_small/1]).
+ otp_10836/1, io_lib_width_too_small/1,
+ io_with_huge_message_queue/1]).
-export([pretty/2]).
@@ -70,7 +71,7 @@ all() ->
io_fread_newlines, otp_8989, io_lib_fread_literal,
printable_range,
io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836,
- io_lib_width_too_small].
+ io_lib_width_too_small, io_with_huge_message_queue].
groups() ->
[].
@@ -2219,3 +2220,44 @@ io_lib_width_too_small(Config) ->
"**" = lists:flatten(io_lib:format("~2.3w", [3.14])),
"**" = lists:flatten(io_lib:format("~2.5w", [3.14])),
ok.
+
+%% Test that the time for a huge message queue is not
+%% significantly slower than with an empty message queue.
+io_with_huge_message_queue(Config) when is_list(Config) ->
+ case test_server:is_native(gen) of
+ true ->
+ {skip,
+ "gen is native - huge message queue optimization "
+ "is not implemented"};
+ false ->
+ do_io_with_huge_message_queue(Config)
+ end.
+
+do_io_with_huge_message_queue(Config) ->
+ PrivDir = ?privdir(Config),
+ File = filename:join(PrivDir, "slask"),
+ {ok, F1} = file:open(File, [write]),
+
+ {Time,ok} = timer:tc(fun() -> writes(1000, F1) end),
+
+ [self() ! {msg,N} || N <- lists:seq(1, 500000)],
+ erlang:garbage_collect(),
+ {NewTime,ok} = timer:tc(fun() -> writes(1000, F1) end),
+ file:close(F1),
+ io:format("Time for empty message queue: ~p", [Time]),
+ io:format("Time for huge message queue: ~p", [NewTime]),
+
+ IsCover = test_server:is_cover(),
+ case (NewTime+1) / (Time+1) of
+ Q when Q < 10; IsCover ->
+ ok;
+ Q ->
+ io:format("Q = ~p", [Q]),
+ ?t:fail()
+ end,
+ ok.
+
+writes(0, _) -> ok;
+writes(N, F1) ->
+ file:write(F1, "hello\n"),
+ writes(N - 1, F1).