aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/ssh/doc/src/notes.xml22
-rw-r--r--lib/ssh/doc/src/ssh.xml6
-rw-r--r--lib/ssh/src/ssh.appup.src54
-rw-r--r--lib/ssh/src/ssh.erl5
-rw-r--r--lib/ssh/src/ssh_acceptor.erl4
-rw-r--r--lib/ssh/src/ssh_connection.erl216
-rw-r--r--lib/ssh/src/ssh_connection_handler.erl11
-rw-r--r--lib/ssh/src/ssh_info.erl146
-rw-r--r--lib/ssh/test/ssh_basic_SUITE.erl62
-rw-r--r--lib/ssh/vsn.mk3
-rw-r--r--lib/stdlib/test/binary_module_SUITE.erl45
-rw-r--r--lib/stdlib/test/ets_SUITE.erl152
-rw-r--r--lib/stdlib/test/gen_event_SUITE.erl173
-rw-r--r--lib/stdlib/test/gen_fsm_SUITE.erl220
-rw-r--r--lib/stdlib/test/gen_server_SUITE.erl139
-rw-r--r--lib/stdlib/test/io_proto_SUITE.erl294
-rw-r--r--lib/stdlib/test/lists_SUITE.erl2
-rw-r--r--lib/stdlib/test/random_SUITE.erl2
-rw-r--r--lib/stdlib/test/select_SUITE.erl2
-rw-r--r--lib/stdlib/test/string_SUITE.erl4
-rw-r--r--lib/stdlib/test/tar_SUITE.erl2
-rw-r--r--lib/stdlib/test/timer_SUITE.erl43
-rw-r--r--lib/stdlib/test/timer_simple_SUITE.erl4
-rw-r--r--lib/stdlib/test/unicode_SUITE.erl172
-rw-r--r--lib/stdlib/test/zip_SUITE.erl4
25 files changed, 970 insertions, 817 deletions
diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml
index f22bca36f4..acbf3124ef 100644
--- a/lib/ssh/doc/src/notes.xml
+++ b/lib/ssh/doc/src/notes.xml
@@ -29,6 +29,28 @@
<file>notes.xml</file>
</header>
+<section><title>Ssh 3.2.1</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Ssh crashed if a message was sent on a channel with
+ packet_size = 0.</p>
+ <p>
+ A new option for ssh:daemon is also introduced:
+ <c>minimal_remote_max_packet_size</c>. This option sets
+ the least max packet size declaration that the daemon
+ will accept from a client. The default value is 0 to
+ maintain compatibility with OpenSSH and the rfc:s.</p>
+ <p>
+ Own Id: OTP-12645 Aux Id: seq12816 </p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Ssh 3.2</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/ssh/doc/src/ssh.xml b/lib/ssh/doc/src/ssh.xml
index d481a75c9a..0e7e3848ad 100644
--- a/lib/ssh/doc/src/ssh.xml
+++ b/lib/ssh/doc/src/ssh.xml
@@ -338,6 +338,12 @@
</warning>
</item>
+ <tag><c><![CDATA[{minimal_remote_max_packet_size, non_negative_integer()}]]></c></tag>
+ <item>
+ <p>The least maximum packet size that the daemon will accept in channel open requests from the client. The default value is 0.
+ </p>
+ </item>
+
<tag><c><![CDATA[{key_cb, atom()}]]></c></tag>
<item>
<p>Module implementing the behaviour <seealso marker="ssh_server_key_api">ssh_server_key_api</seealso>.
diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src
index b2b2994eed..e76c110c04 100644
--- a/lib/ssh/src/ssh.appup.src
+++ b/lib/ssh/src/ssh.appup.src
@@ -1,7 +1,7 @@
%% -*- erlang -*-
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2015. 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
@@ -19,61 +19,9 @@
{"%VSN%",
[
- {"3.0.8", [{load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_xfer]},
- {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
- {load_module, ssh, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_xfer, soft_purge, soft_purge, []}
- ]},
- {"3.0.7", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
- {load_module, ssh_info, soft_purge, soft_purge, []},
- {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]},
- {"3.0.6", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
- {load_module, ssh_info, soft_purge, soft_purge, []},
- {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]},
{<<".*">>, [{restart_application, ssh}]}
],
[
- {"3.0.8", [{load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_sftp, soft_purge, soft_purge, []},
- {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
- {load_module, ssh, soft_purge, soft_purge, []},
- {load_module, ssh_xfer, soft_purge, soft_purge, []}
- ]},
- {"3.0.7", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
- {load_module, ssh_info, soft_purge, soft_purge, []},
- {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]},
- {"3.0.6", [{load_module, ssh_auth, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_acceptor, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_channel, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_connection_handler, soft_purge, soft_purge, []},
- {load_module, ssh_info, soft_purge, soft_purge, []},
- {load_module, ssh_message, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_io, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_sftp, soft_purge, soft_purge, [ssh_connection_handler]},
- {load_module, ssh_xfer, soft_purge, soft_purge, [ssh_connection_handler]}]},
{<<".*">>, [{restart_application, ssh}]}
]
}.
diff --git a/lib/ssh/src/ssh.erl b/lib/ssh/src/ssh.erl
index eae33e3683..51ad691ba2 100644
--- a/lib/ssh/src/ssh.erl
+++ b/lib/ssh/src/ssh.erl
@@ -345,9 +345,14 @@ handle_option([{parallel_login, _} = Opt|Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([parallel_login|Rest], SocketOptions, SshOptions) ->
handle_option(Rest, SocketOptions, [handle_ssh_option({parallel_login,true}) | SshOptions]);
+handle_option([{minimal_remote_max_packet_size, _} = Opt|Rest], SocketOptions, SshOptions) ->
+ handle_option(Rest, SocketOptions, [handle_ssh_option(Opt) | SshOptions]);
handle_option([Opt | Rest], SocketOptions, SshOptions) ->
handle_option(Rest, [handle_inet_option(Opt) | SocketOptions], SshOptions).
+
+handle_ssh_option({minimal_remote_max_packet_size, Value} = Opt) when is_integer(Value), Value >=0 ->
+ Opt;
handle_ssh_option({system_dir, Value} = Opt) when is_list(Value) ->
Opt;
handle_ssh_option({user_dir, Value} = Opt) when is_list(Value) ->
diff --git a/lib/ssh/src/ssh_acceptor.erl b/lib/ssh/src/ssh_acceptor.erl
index 6c443eeb9c..34988f17b6 100644
--- a/lib/ssh/src/ssh_acceptor.erl
+++ b/lib/ssh/src/ssh_acceptor.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2013. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2015. 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
@@ -43,7 +43,7 @@ start_link(Port, Address, SockOpts, Opts, AcceptTimeout) ->
acceptor_init(Parent, Port, Address, SockOpts, Opts, AcceptTimeout) ->
{_, Callback, _} =
proplists:get_value(transport, Opts, {tcp, gen_tcp, tcp_closed}),
- case (catch do_socket_listen(Callback, Port, SockOpts)) of
+ case (catch do_socket_listen(Callback, Port, [{active, false} | SockOpts])) of
{ok, ListenSocket} ->
proc_lib:init_ack(Parent, {ok, self()}),
acceptor_loop(Callback,
diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl
index e97bf9ceeb..388c080d99 100644
--- a/lib/ssh/src/ssh_connection.erl
+++ b/lib/ssh/src/ssh_connection.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2015. 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
@@ -326,9 +326,7 @@ channel_data(ChannelId, DataType, Data,
SendDataType,
SendData)}
end, SendList),
- FlowCtrlMsgs = flow_control(Replies,
- Channel,
- Cache),
+ FlowCtrlMsgs = flow_control(Replies, Channel, Cache),
{{replies, Replies ++ FlowCtrlMsgs}, Connection};
_ ->
gen_fsm:reply(From, {error, closed}),
@@ -470,18 +468,31 @@ handle_msg(#ssh_msg_channel_window_adjust{recipient_channel = ChannelId,
handle_msg(#ssh_msg_channel_open{channel_type = "session" = Type,
sender_channel = RemoteId,
initial_window_size = WindowSz,
- maximum_packet_size = PacketSz}, Connection0, server) ->
-
- try setup_session(Connection0, RemoteId,
- Type, WindowSz, PacketSz) of
- Result ->
- Result
- catch _:_ ->
+ maximum_packet_size = PacketSz},
+ #connection{options = SSHopts} = Connection0,
+ server) ->
+ MinAcceptedPackSz = proplists:get_value(minimal_remote_max_packet_size, SSHopts, 0),
+
+ if
+ MinAcceptedPackSz =< PacketSz ->
+ try setup_session(Connection0, RemoteId,
+ Type, WindowSz, PacketSz) of
+ Result ->
+ Result
+ catch _:_ ->
+ FailMsg = channel_open_failure_msg(RemoteId,
+ ?SSH_OPEN_CONNECT_FAILED,
+ "Connection refused", "en"),
+ {{replies, [{connection_reply, FailMsg}]},
+ Connection0}
+ end;
+
+ MinAcceptedPackSz > PacketSz ->
FailMsg = channel_open_failure_msg(RemoteId,
- ?SSH_OPEN_CONNECT_FAILED,
- "Connection refused", "en"),
- {{replies, [{connection_reply, FailMsg}]},
- Connection0}
+ ?SSH_OPEN_ADMINISTRATIVELY_PROHIBITED,
+ lists:concat(["Maximum packet size below ",MinAcceptedPackSz,
+ " not supported"]), "en"),
+ {{replies, [{connection_reply, FailMsg}]}, Connection0}
end;
handle_msg(#ssh_msg_channel_open{channel_type = "session",
@@ -501,41 +512,57 @@ handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip" = Type,
initial_window_size = RWindowSz,
maximum_packet_size = RPacketSz,
data = Data},
- #connection{channel_cache = Cache} = Connection0, server) ->
+ #connection{channel_cache = Cache,
+ options = SSHopts} = Connection0, server) ->
<<?UINT32(ALen), Address:ALen/binary, ?UINT32(Port),
?UINT32(OLen), Orig:OLen/binary, ?UINT32(OrigPort)>> = Data,
- case bound_channel(Address, Port, Connection0) of
- undefined ->
+ MinAcceptedPackSz = proplists:get_value(minimal_remote_max_packet_size, SSHopts, 0),
+
+ if
+ MinAcceptedPackSz =< RPacketSz ->
+ case bound_channel(Address, Port, Connection0) of
+ undefined ->
+ FailMsg = channel_open_failure_msg(RemoteId,
+ ?SSH_OPEN_CONNECT_FAILED,
+ "Connection refused", "en"),
+ {{replies,
+ [{connection_reply, FailMsg}]}, Connection0};
+ ChannelPid ->
+ {ChannelId, Connection1} = new_channel_id(Connection0),
+ LWindowSz = ?DEFAULT_WINDOW_SIZE,
+ LPacketSz = ?DEFAULT_PACKET_SIZE,
+ Channel = #channel{type = Type,
+ sys = "none",
+ user = ChannelPid,
+ local_id = ChannelId,
+ recv_window_size = LWindowSz,
+ recv_packet_size = LPacketSz,
+ send_window_size = RWindowSz,
+ send_packet_size = RPacketSz,
+ send_buf = queue:new()
+ },
+ ssh_channel:cache_update(Cache, Channel),
+ OpenConfMsg = channel_open_confirmation_msg(RemoteId, ChannelId,
+ LWindowSz, LPacketSz),
+ {OpenMsg, Connection} =
+ reply_msg(Channel, Connection1,
+ {open, Channel, {forwarded_tcpip,
+ decode_ip(Address), Port,
+ decode_ip(Orig), OrigPort}}),
+ {{replies, [{connection_reply, OpenConfMsg},
+ OpenMsg]}, Connection}
+ end;
+
+ MinAcceptedPackSz > RPacketSz ->
FailMsg = channel_open_failure_msg(RemoteId,
- ?SSH_OPEN_CONNECT_FAILED,
- "Connection refused", "en"),
- {{replies,
- [{connection_reply, FailMsg}]}, Connection0};
- ChannelPid ->
- {ChannelId, Connection1} = new_channel_id(Connection0),
- LWindowSz = ?DEFAULT_WINDOW_SIZE,
- LPacketSz = ?DEFAULT_PACKET_SIZE,
- Channel = #channel{type = Type,
- sys = "none",
- user = ChannelPid,
- local_id = ChannelId,
- recv_window_size = LWindowSz,
- recv_packet_size = LPacketSz,
- send_window_size = RWindowSz,
- send_packet_size = RPacketSz},
- ssh_channel:cache_update(Cache, Channel),
- OpenConfMsg = channel_open_confirmation_msg(RemoteId, ChannelId,
- LWindowSz, LPacketSz),
- {OpenMsg, Connection} =
- reply_msg(Channel, Connection1,
- {open, Channel, {forwarded_tcpip,
- decode_ip(Address), Port,
- decode_ip(Orig), OrigPort}}),
- {{replies, [{connection_reply, OpenConfMsg},
- OpenMsg]}, Connection}
+ ?SSH_OPEN_ADMINISTRATIVELY_PROHIBITED,
+ lists:concat(["Maximum packet size below ",MinAcceptedPackSz,
+ " not supported"]), "en"),
+ {{replies, [{connection_reply, FailMsg}]}, Connection0}
end;
+
handle_msg(#ssh_msg_channel_open{channel_type = "forwarded-tcpip",
sender_channel = RemoteId},
Connection, client) ->
@@ -917,7 +944,8 @@ start_channel(Cb, Id, Args, SubSysSup, Exec) ->
%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------
-setup_session(#connection{channel_cache = Cache} = Connection0,
+setup_session(#connection{channel_cache = Cache
+ } = Connection0,
RemoteId,
Type, WindowSize, PacketSize) ->
{ChannelId, Connection} = new_channel_id(Connection0),
@@ -929,6 +957,7 @@ setup_session(#connection{channel_cache = Cache} = Connection0,
recv_packet_size = ?DEFAULT_PACKET_SIZE,
send_window_size = WindowSize,
send_packet_size = PacketSize,
+ send_buf = queue:new(),
remote_id = RemoteId
},
ssh_channel:cache_update(Cache, Channel),
@@ -1024,63 +1053,74 @@ request_reply_or_data(#channel{local_id = ChannelId, user = ChannelPid},
update_send_window(Channel, _, undefined,
#connection{channel_cache = Cache}) ->
- do_update_send_window(Channel, Channel#channel.send_buf, Cache);
+ do_update_send_window(Channel, Cache);
-update_send_window(Channel, DataType, Data,
+update_send_window(#channel{send_buf = SendBuffer} = Channel, DataType, Data,
#connection{channel_cache = Cache}) ->
- do_update_send_window(Channel, Channel#channel.send_buf ++ [{DataType, Data}], Cache).
-
-do_update_send_window(Channel0, Buf0, Cache) ->
- {Buf1, NewSz, Buf2} = get_window(Buf0,
- Channel0#channel.send_packet_size,
- Channel0#channel.send_window_size),
+ do_update_send_window(Channel#channel{send_buf = queue:in({DataType, Data}, SendBuffer)},
+ Cache).
- Channel = Channel0#channel{send_window_size = NewSz, send_buf = Buf2},
+do_update_send_window(Channel0, Cache) ->
+ {SendMsgs, Channel} = get_window(Channel0, []),
ssh_channel:cache_update(Cache, Channel),
- {Buf1, Channel}.
-
-get_window(Bs, PSz, WSz) ->
- get_window(Bs, PSz, WSz, []).
-
-get_window(Bs, _PSz, 0, Acc) ->
- {lists:reverse(Acc), 0, Bs};
-get_window([B0 = {DataType, Bin} | Bs], PSz, WSz, Acc) ->
- BSz = size(Bin),
- if BSz =< WSz -> %% will fit into window
- if BSz =< PSz -> %% will fit into a packet
- get_window(Bs, PSz, WSz-BSz, [B0|Acc]);
- true -> %% split into packet size
- <<Bin1:PSz/binary, Bin2/binary>> = Bin,
- get_window([setelement(2, B0, Bin2) | Bs],
- PSz, WSz-PSz,
- [{DataType, Bin1}|Acc])
+ {SendMsgs, Channel}.
+
+get_window(#channel{send_window_size = 0
+ } = Channel, Acc) ->
+ {lists:reverse(Acc), Channel};
+get_window(#channel{send_packet_size = 0
+ } = Channel, Acc) ->
+ {lists:reverse(Acc), Channel};
+get_window(#channel{send_buf = Buffer,
+ send_packet_size = PacketSize,
+ send_window_size = WindowSize0
+ } = Channel, Acc0) ->
+ case queue:out(Buffer) of
+ {{value, {_, Data} = Msg}, NewBuffer} ->
+ case handle_send_window(Msg, size(Data), PacketSize, WindowSize0, Acc0) of
+ {WindowSize, Acc, {_, <<>>}} ->
+ {lists:reverse(Acc), Channel#channel{send_window_size = WindowSize,
+ send_buf = NewBuffer}};
+ {WindowSize, Acc, Rest} ->
+ get_window(Channel#channel{send_window_size = WindowSize,
+ send_buf = queue:in_r(Rest, NewBuffer)}, Acc)
end;
- WSz =< PSz -> %% use rest of window
- <<Bin1:WSz/binary, Bin2/binary>> = Bin,
- get_window([setelement(2, B0, Bin2) | Bs],
- PSz, WSz-WSz,
- [{DataType, Bin1}|Acc]);
- true -> %% use packet size
- <<Bin1:PSz/binary, Bin2/binary>> = Bin,
- get_window([setelement(2, B0, Bin2) | Bs],
- PSz, WSz-PSz,
- [{DataType, Bin1}|Acc])
+ {empty, NewBuffer} ->
+ {[], Channel#channel{send_buf = NewBuffer}}
+ end.
+
+handle_send_window(Msg = {Type, Data}, Size, PacketSize, WindowSize, Acc) when Size =< WindowSize ->
+ case Size =< PacketSize of
+ true ->
+ {WindowSize - Size, [Msg | Acc], {Type, <<>>}};
+ false ->
+ <<Msg1:PacketSize/binary, Msg2/binary>> = Data,
+ {WindowSize - PacketSize, [{Type, Msg1} | Acc], {Type, Msg2}}
end;
-get_window([], _PSz, WSz, Acc) ->
- {lists:reverse(Acc), WSz, []}.
+handle_send_window({Type, Data}, _, PacketSize, WindowSize, Acc) when WindowSize =< PacketSize ->
+ <<Msg1:WindowSize/binary, Msg2/binary>> = Data,
+ {WindowSize - WindowSize, [{Type, Msg1} | Acc], {Type, Msg2}};
+handle_send_window({Type, Data}, _, PacketSize, WindowSize, Acc) ->
+ <<Msg1:PacketSize/binary, Msg2/binary>> = Data,
+ {WindowSize - PacketSize, [{Type, Msg1} | Acc], {Type, Msg2}}.
flow_control(Channel, Cache) ->
flow_control([window_adjusted], Channel, Cache).
-
+
flow_control([], Channel, Cache) ->
ssh_channel:cache_update(Cache, Channel),
[];
-
flow_control([_|_], #channel{flow_control = From,
- send_buf = []} = Channel, Cache) when From =/= undefined ->
- [{flow_control, Cache, Channel, From, ok}];
+ send_buf = Buffer} = Channel, Cache) when From =/= undefined ->
+ case queue:is_empty(Buffer) of
+ true ->
+ ssh_channel:cache_update(Cache, Channel#channel{flow_control = undefined}),
+ [{flow_control, Cache, Channel, From, ok}];
+ false ->
+ []
+ end;
flow_control(_,_,_) ->
- [].
+ [].
pty_req(ConnectionHandler, Channel, Term, Width, Height,
PixWidth, PixHeight, PtyOpts, TimeOut) ->
diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl
index 68523aa72b..e1f2e059e8 100644
--- a/lib/ssh/src/ssh_connection_handler.erl
+++ b/lib/ssh/src/ssh_connection_handler.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2008-2014. All Rights Reserved.
+%% Copyright Ericsson AB 2008-2015. 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
@@ -751,7 +751,9 @@ handle_sync_event({open, ChannelPid, Type, InitialWindowSize, MaxPacketSize, Dat
user = ChannelPid,
local_id = ChannelId,
recv_window_size = InitialWindowSize,
- recv_packet_size = MaxPacketSize},
+ recv_packet_size = MaxPacketSize,
+ send_buf = queue:new()
+ },
ssh_channel:cache_update(Cache, Channel),
State = add_request(true, ChannelId, From, State2),
start_timeout(ChannelId, From, Timeout),
@@ -1241,10 +1243,9 @@ event(Event, StateName, State) ->
handle_disconnect(DisconnectMsg, State);
throw:{ErrorToDisplay, #ssh_msg_disconnect{} = DisconnectMsg} ->
handle_disconnect(DisconnectMsg, State, ErrorToDisplay);
- _:Error ->
- log_error(Error),
+ _:_ ->
handle_disconnect(#ssh_msg_disconnect{code = error_code(StateName),
- description = "Internal error",
+ description = "Invalid state",
language = "en"}, State)
end.
error_code(key_exchange) ->
diff --git a/lib/ssh/src/ssh_info.erl b/lib/ssh/src/ssh_info.erl
index eae9ded5c6..9c79d773a7 100644
--- a/lib/ssh/src/ssh_info.erl
+++ b/lib/ssh/src/ssh_info.erl
@@ -27,18 +27,21 @@
-compile(export_all).
print() ->
+ print(user).
+
+print(D) ->
try supervisor:which_children(ssh_sup)
of
_ ->
- io:nl(),
- print_general(),
- io:nl(),
- underline("Client part", $=),
- print_clients(),
- io:nl(),
- underline("Server part", $=),
- print_servers(),
- io:nl(),
+ io:nl(D),
+ print_general(D),
+ io:nl(D),
+ underline(D, "Client part", $=),
+ print_clients(D),
+ io:nl(D),
+ underline(D, "Server part", $=),
+ print_servers(D),
+ io:nl(D),
%% case os:type() of
%% {unix,_} ->
%% io:nl(),
@@ -50,90 +53,95 @@ print() ->
%% catch io:format(os:cmd("netstat -tpn"));
%% _ -> ok
%% end,
- underline("Supervisors", $=),
- walk_sups(ssh_sup),
- io:nl()
+ underline(D, "Supervisors", $=),
+ walk_sups(D, ssh_sup),
+ io:nl(D)
catch
_:_ ->
- io:format("Ssh not found~n",[])
+ io:format(D,"Ssh not found~n",[])
end.
%%%================================================================
-print_general() ->
+print_general(D) ->
{_Name, Slogan, Ver} = lists:keyfind(ssh,1,application:which_applications()),
- underline(io_lib:format("~s ~s", [Slogan, Ver]), $=),
- io:format('This printout is generated ~s. ~n',[datetime()]).
+ underline(D, io_lib:format("~s ~s", [Slogan, Ver]), $=),
+ io:format(D, 'This printout is generated ~s. ~n',[datetime()]).
%%%================================================================
-print_clients() ->
+print_clients(D) ->
+ PrintClient = fun(X) -> print_client(D,X) end,
try
- lists:foreach(fun print_client/1, supervisor:which_children(sshc_sup))
+ lists:foreach(PrintClient, supervisor:which_children(sshc_sup))
catch
C:E ->
- io:format('***FAILED: ~p:~p~n',[C,E])
+ io:format(D, '***FAILED: ~p:~p~n',[C,E])
end.
-print_client({undefined,Pid,supervisor,[ssh_connection_handler]}) ->
+print_client(D, {undefined,Pid,supervisor,[ssh_connection_handler]}) ->
{{Local,Remote},_Str} = ssh_connection_handler:get_print_info(Pid),
- io:format(" Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]);
-print_client(Other) ->
- io:format(" [[Other 1: ~p]]~n",[Other]).
+ io:format(D, " Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]);
+print_client(D, Other) ->
+ io:format(D, " [[Other 1: ~p]]~n",[Other]).
%%%================================================================
-print_servers() ->
+print_servers(D) ->
+ PrintServer = fun(X) -> print_server(D,X) end,
try
- lists:foreach(fun print_server/1, supervisor:which_children(sshd_sup))
+ lists:foreach(PrintServer, supervisor:which_children(sshd_sup))
catch
C:E ->
- io:format('***FAILED: ~p:~p~n',[C,E])
+ io:format(D, '***FAILED: ~p:~p~n',[C,E])
end.
-print_server({{server,ssh_system_sup,LocalHost,LocalPort},Pid,supervisor,[ssh_system_sup]}) when is_pid(Pid) ->
- io:format('Local=~s (~p children)~n',[fmt_host_port({LocalHost,LocalPort}),
- ssh_acceptor:number_of_connections(Pid)]),
- lists:foreach(fun print_system_sup/1, supervisor:which_children(Pid));
-print_server(Other) ->
- io:format(" [[Other 2: ~p]]~n",[Other]).
+print_server(D, {{server,ssh_system_sup,LocalHost,LocalPort},Pid,supervisor,[ssh_system_sup]}) when is_pid(Pid) ->
+ io:format(D, 'Local=~s (~p children)~n',[fmt_host_port({LocalHost,LocalPort}),
+ ssh_acceptor:number_of_connections(Pid)]),
+ PrintSystemSup = fun(X) -> print_system_sup(D,X) end,
+ lists:foreach(PrintSystemSup, supervisor:which_children(Pid));
+print_server(D, Other) ->
+ io:format(D, " [[Other 2: ~p]]~n",[Other]).
-print_system_sup({Ref,Pid,supervisor,[ssh_subsystem_sup]}) when is_reference(Ref),
+print_system_sup(D, {Ref,Pid,supervisor,[ssh_subsystem_sup]}) when is_reference(Ref),
is_pid(Pid) ->
- lists:foreach(fun print_channels/1, supervisor:which_children(Pid));
-print_system_sup({{ssh_acceptor_sup,LocalHost,LocalPort}, Pid,supervisor, [ssh_acceptor_sup]}) when is_pid(Pid) ->
- io:format(" [Acceptor for ~s]~n",[fmt_host_port({LocalHost,LocalPort})]);
-print_system_sup(Other) ->
- io:format(" [[Other 3: ~p]]~n",[Other]).
-
-print_channels({{server,ssh_channel_sup,_,_},Pid,supervisor,[ssh_channel_sup]}) when is_pid(Pid) ->
- lists:foreach(fun print_channel/1, supervisor:which_children(Pid));
-print_channels(Other) ->
- io:format(" [[Other 4: ~p]]~n",[Other]).
-
-
-print_channel({Ref,Pid,worker,[ssh_channel]}) when is_reference(Ref),
- is_pid(Pid) ->
+ PrintChannels = fun(X) -> print_channels(D,X) end,
+ lists:foreach(PrintChannels, supervisor:which_children(Pid));
+print_system_sup(D, {{ssh_acceptor_sup,LocalHost,LocalPort}, Pid,supervisor, [ssh_acceptor_sup]}) when is_pid(Pid) ->
+ io:format(D, " [Acceptor for ~s]~n",[fmt_host_port({LocalHost,LocalPort})]);
+print_system_sup(D, Other) ->
+ io:format(D, " [[Other 3: ~p]]~n",[Other]).
+
+print_channels(D, {{server,ssh_channel_sup,_,_},Pid,supervisor,[ssh_channel_sup]}) when is_pid(Pid) ->
+ PrintChannel = fun(X) -> print_channel(D,X) end,
+ lists:foreach(PrintChannel, supervisor:which_children(Pid));
+print_channels(D, Other) ->
+ io:format(D, " [[Other 4: ~p]]~n",[Other]).
+
+
+print_channel(D, {Ref,Pid,worker,[ssh_channel]}) when is_reference(Ref),
+ is_pid(Pid) ->
{{ConnManager,ChannelID}, Str} = ssh_channel:get_print_info(Pid),
{{Local,Remote},StrM} = ssh_connection_handler:get_print_info(ConnManager),
- io:format(' ch ~p: ~s ~s',[ChannelID, StrM, Str]),
- io:format(" Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]);
-print_channel(Other) ->
- io:format(" [[Other 5: ~p]]~n",[Other]).
+ io:format(D, ' ch ~p: ~s ~s',[ChannelID, StrM, Str]),
+ io:format(D, " Local=~s Remote=~s~n",[fmt_host_port(Local),fmt_host_port(Remote)]);
+print_channel(D, Other) ->
+ io:format(D, " [[Other 5: ~p]]~n",[Other]).
%%%================================================================
-define(inc(N), (N+4)).
-walk_sups(StartPid) ->
- io:format("Start at ~p, ~s.~n",[StartPid,dead_or_alive(StartPid)]),
- walk_sups(children(StartPid), _Indent=?inc(0)).
+walk_sups(D, StartPid) ->
+ io:format(D, "Start at ~p, ~s.~n",[StartPid,dead_or_alive(StartPid)]),
+ walk_sups(D, children(StartPid), _Indent=?inc(0)).
-walk_sups([H={_,Pid,SupOrWorker,_}|T], Indent) ->
- indent(Indent), io:format('~200p ~p is ~s~n',[H,Pid,dead_or_alive(Pid)]),
+walk_sups(D, [H={_,Pid,SupOrWorker,_}|T], Indent) ->
+ indent(D, Indent), io:format(D, '~200p ~p is ~s~n',[H,Pid,dead_or_alive(Pid)]),
case SupOrWorker of
- supervisor -> walk_sups(children(Pid), ?inc(Indent));
+ supervisor -> walk_sups(D, children(Pid), ?inc(Indent));
_ -> ok
end,
- walk_sups(T, Indent);
-walk_sups([], _) ->
+ walk_sups(D, T, Indent);
+walk_sups(_D, [], _) ->
ok.
dead_or_alive(Name) when is_atom(Name) ->
@@ -149,7 +157,7 @@ dead_or_alive(Pid) when is_pid(Pid) ->
_ -> "alive"
end.
-indent(I) -> io:format('~*c',[I,$ ]).
+indent(D, I) -> io:format(D,'~*c',[I,$ ]).
children(Pid) ->
Parent = self(),
@@ -166,16 +174,16 @@ children(Pid) ->
end.
%%%================================================================
-underline(Str) ->
- underline(Str, $-).
+underline(D, Str) ->
+ underline(D, Str, $-).
-underline(Str, LineChar) ->
+underline(D, Str, LineChar) ->
Len = lists:flatlength(Str),
- io:format('~s~n',[Str]),
- line(Len,LineChar).
+ io:format(D, '~s~n',[Str]),
+ line(D,Len,LineChar).
-line(Len, Char) ->
- io:format('~*c~n', [Len,Char]).
+line(D, Len, Char) ->
+ io:format(D, '~*c~n', [Len,Char]).
datetime() ->
@@ -188,6 +196,6 @@ fmt_host_port({Host,Port}) -> io_lib:format('~s:~p',[Host,Port]).
-nyi() ->
- io:format('Not yet implemented~n',[]),
+nyi(D) ->
+ io:format(D,'Not yet implemented~n',[]),
nyi.
diff --git a/lib/ssh/test/ssh_basic_SUITE.erl b/lib/ssh/test/ssh_basic_SUITE.erl
index 4c5498dc0e..3331038450 100644
--- a/lib/ssh/test/ssh_basic_SUITE.erl
+++ b/lib/ssh/test/ssh_basic_SUITE.erl
@@ -50,6 +50,8 @@ all() ->
double_close,
ssh_connect_timeout,
ssh_connect_arg4_timeout,
+ packet_size_zero,
+ ssh_daemon_minimal_remote_max_packet_size_option,
{group, hardening_tests}
].
@@ -756,6 +758,64 @@ ms_passed(T0) ->
micro_seconds) / 1000.
%%--------------------------------------------------------------------
+packet_size_zero(Config) ->
+ SystemDir = ?config(data_dir, Config),
+ PrivDir = ?config(priv_dir, Config),
+ UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
+ file:make_dir(UserDir),
+
+ {Server, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {user_passwords, [{"vego", "morot"}]}]),
+ Conn =
+ ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_dir, UserDir},
+ {user_interaction, false},
+ {user, "vego"},
+ {password, "morot"}]),
+
+ {ok,Chan} = ssh_connection:session_channel(Conn, 1000, _MaxPacketSize=0, 60000),
+ ok = ssh_connection:shell(Conn, Chan),
+
+ ssh:close(Conn),
+ ssh:stop_daemon(Server),
+
+ receive
+ {ssh_cm,Conn,{data,Chan,_Type,_Msg1}} = M ->
+ ct:pal("Got ~p",[M]),
+ ct:fail(doesnt_obey_max_packet_size_0)
+ after 5000 ->
+ ok
+ end.
+
+%%--------------------------------------------------------------------
+ssh_daemon_minimal_remote_max_packet_size_option(Config) ->
+ SystemDir = ?config(data_dir, Config),
+ PrivDir = ?config(priv_dir, Config),
+ UserDir = filename:join(PrivDir, nopubkey), % to make sure we don't use public-key-auth
+ file:make_dir(UserDir),
+
+ {Server, Host, Port} = ssh_test_lib:daemon([{system_dir, SystemDir},
+ {user_dir, UserDir},
+ {user_passwords, [{"vego", "morot"}]},
+ {failfun, fun ssh_test_lib:failfun/2},
+ {minimal_remote_max_packet_size, 14}]),
+ Conn =
+ ssh_test_lib:connect(Host, Port, [{silently_accept_hosts, true},
+ {user_dir, UserDir},
+ {user_interaction, false},
+ {user, "vego"},
+ {password, "morot"}]),
+
+ %% Try the limits of the minimal_remote_max_packet_size:
+ {ok, _ChannelId} = ssh_connection:session_channel(Conn, 100, 14, infinity),
+ {open_error,_,"Maximum packet size below 14 not supported",_} =
+ ssh_connection:session_channel(Conn, 100, 13, infinity),
+
+ ssh:close(Conn),
+ ssh:stop_daemon(Server).
+
+%%--------------------------------------------------------------------
ssh_connect_negtimeout_parallel(Config) -> ssh_connect_negtimeout(Config,true).
ssh_connect_negtimeout_sequential(Config) -> ssh_connect_negtimeout(Config,false).
@@ -969,7 +1029,7 @@ max_sessions(Config, ParallelLogin, Connect0) when is_function(Connect0,2) ->
%% Due to timing the error message may or may not be delivered to
%% the "tcp-application" before the socket closed message is recived
-check_error("Internal error") ->
+check_error("Invalid state") ->
ok;
check_error("Connection closed") ->
ok;
diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk
index 0d90278977..fec8dacab7 100644
--- a/lib/ssh/vsn.mk
+++ b/lib/ssh/vsn.mk
@@ -1,5 +1,4 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
-SSH_VSN = 3.2
+SSH_VSN = 3.2.1
APP_VSN = "ssh-$(SSH_VSN)"
-
diff --git a/lib/stdlib/test/binary_module_SUITE.erl b/lib/stdlib/test/binary_module_SUITE.erl
index f828c70b63..5248870744 100644
--- a/lib/stdlib/test/binary_module_SUITE.erl
+++ b/lib/stdlib/test/binary_module_SUITE.erl
@@ -1130,7 +1130,9 @@ do_random_matches_comp3(N,NeedleRange,HaystackRange) ->
Needles = [random_substring(NeedleRange,Haystack) ||
_ <- lists:duplicate(NumNeedles,a)],
RefRes = binref:matches(Haystack,Needles),
- true = do_matches_comp_loop(10000,Needles,Haystack, RefRes),
+ RefRes = binary:matches(Haystack,Needles),
+ Compiled = binary:compile_pattern(Needles),
+ true = do_matches_comp_loop(10000,Compiled,Haystack, RefRes),
do_random_matches_comp3(N-1,NeedleRange,HaystackRange).
do_matches_comp_loop(0,_,_,_) ->
@@ -1160,9 +1162,8 @@ do_matches_comp2(N,H,A) ->
end.
do_matches_comp(N,H) ->
A = ?MASK_ERROR(binref:matches(H,N)),
- B = ?MASK_ERROR(binref:matches(H,binref:compile_pattern(N))),
- C = ?MASK_ERROR(binary:matches(H,N)),
- D = ?MASK_ERROR(binary:matches(make_unaligned(H),
+ B = ?MASK_ERROR(binary:matches(H,N)),
+ C = ?MASK_ERROR(binary:matches(make_unaligned(H),
binary:compile_pattern([make_unaligned2(X) || X <- N]))),
if
A =/= nomatch ->
@@ -1170,14 +1171,14 @@ do_matches_comp(N,H) ->
true ->
ok
end,
- case {(A =:= B), (B =:= C),(C =:= D)} of
- {true,true,true} ->
+ case {(A =:= B), (B =:= C)} of
+ {true,true} ->
true;
_ ->
io:format("Failed to match ~p (needle) against ~s (haystack)~n",
[N,H]),
- io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p.~n",
- [A,B,C,D]),
+ io:format("A:~p,~nB:~p,~n,C:~p,~n",
+ [A,B,C]),
exit(mismatch)
end.
@@ -1219,46 +1220,44 @@ do_random_match_comp4(N,NeedleRange,HaystackRange) ->
do_match_comp(N,H) ->
A = ?MASK_ERROR(binref:match(H,N)),
- B = ?MASK_ERROR(binref:match(H,binref:compile_pattern([N]))),
- C = ?MASK_ERROR(binary:match(make_unaligned(H),N)),
- D = ?MASK_ERROR(binary:match(H,binary:compile_pattern([N]))),
- E = ?MASK_ERROR(binary:match(H,binary:compile_pattern(make_unaligned(N)))),
+ B = ?MASK_ERROR(binary:match(make_unaligned(H),N)),
+ C = ?MASK_ERROR(binary:match(H,binary:compile_pattern([N]))),
+ D = ?MASK_ERROR(binary:match(H,binary:compile_pattern(make_unaligned(N)))),
if
A =/= nomatch ->
put(success_counter,get(success_counter)+1);
true ->
ok
end,
- case {(A =:= B), (B =:= C),(C =:= D),(D =:= E)} of
- {true,true,true,true} ->
+ case {(A =:= B), (B =:= C),(C =:= D)} of
+ {true,true,true} ->
true;
_ ->
io:format("Failed to match ~s (needle) against ~s (haystack)~n",
[N,H]),
- io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p,E:~p.~n",
- [A,B,C,D,E]),
+ io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p.~n",
+ [A,B,C,D]),
exit(mismatch)
end.
do_match_comp3(N,H) ->
A = ?MASK_ERROR(binref:match(H,N)),
- B = ?MASK_ERROR(binref:match(H,binref:compile_pattern(N))),
- C = ?MASK_ERROR(binary:match(H,N)),
- D = ?MASK_ERROR(binary:match(H,binary:compile_pattern(N))),
+ B = ?MASK_ERROR(binary:match(H,N)),
+ C = ?MASK_ERROR(binary:match(H,binary:compile_pattern(N))),
if
A =/= nomatch ->
put(success_counter,get(success_counter)+1);
true ->
ok
end,
- case {(A =:= B), (B =:= C),(C =:= D)} of
- {true,true,true} ->
+ case {(A =:= B),(B =:= C)} of
+ {true,true} ->
true;
_ ->
io:format("Failed to match ~s (needle) against ~s (haystack)~n",
[N,H]),
- io:format("A:~p,~nB:~p,~n,C:~p,~n,D:~p.~n",
- [A,B,C,D]),
+ io:format("A:~p,~nB:~p,~n,C:~p.~n",
+ [A,B,C]),
exit(mismatch)
end.
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 4de4a0cdb0..5774d774b5 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -1385,7 +1385,7 @@ random_test() ->
{ok,[X]} ->
X;
_ ->
- {A,B,C} = erlang:now(),
+ {A,B,C} = erlang:timestamp(),
random:seed(A,B,C),
get(random_seed)
end,
@@ -3541,12 +3541,9 @@ verify_rescheduling_exit(Config, ForEachData, Flags, Fix, NOTabs, NOProcs) ->
fun () ->
repeat(
fun () ->
- {A, B, C} = now(),
- ?line Name = list_to_atom(
- TestCase
- ++ "-" ++ integer_to_list(A)
- ++ "-" ++ integer_to_list(B)
- ++ "-" ++ integer_to_list(C)),
+ Uniq = erlang:unique_integer([positive]),
+ Name = list_to_atom(TestCase ++ "-" ++
+ integer_to_list(Uniq)),
Tab = ets_new(Name, Flags),
ForEachData(fun(Data) -> ets:insert(Tab, Data) end),
case Fix of
@@ -4552,16 +4549,16 @@ build_table2(L1,L2,Num) ->
T.
time_match_object(Tab,Match, Res) ->
- T1 = erlang:now(),
+ T1 = erlang:monotonic_time(micro_seconds),
Res = ets:match_object(Tab,Match),
- T2 = erlang:now(),
- nowdiff(T1,T2).
+ T2 = erlang:monotonic_time(micro_seconds),
+ T2 - T1.
time_match(Tab,Match) ->
- T1 = erlang:now(),
+ T1 = erlang:monotonic_time(micro_seconds),
ets:match(Tab,Match),
- T2 = erlang:now(),
- nowdiff(T1,T2).
+ T2 = erlang:monotonic_time(micro_seconds),
+ T2 - T1.
seventyfive_percent_success(_,S,Fa,0) ->
true = (S > ((S + Fa) * 0.75));
@@ -4586,11 +4583,6 @@ fifty_percent_success({M,F,A},S,Fa,N) ->
end.
-nowtonumber({Mega, Secs, Milli}) ->
- Milli + Secs * 1000000 + Mega * 1000000000000.
-nowdiff(T1,T2) ->
- nowtonumber(T2) - nowtonumber(T1).
-
create_random_string(0) ->
[];
@@ -5118,17 +5110,29 @@ grow_pseudo_deleted_do(Type) ->
?line Left = ets:info(T,size),
?line Mult = get_kept_objects(T),
filltabstr(T,Mult),
- my_spawn_opt(fun()-> ?line true = ets:info(T,fixed),
- Self ! start,
- io:format("Starting to filltabstr... ~p\n",[now()]),
- filltabstr(T,Mult,Mult+10000),
- io:format("Done with filltabstr. ~p\n",[now()]),
- Self ! done
- end, [link, {scheduler,2}]),
+ my_spawn_opt(
+ fun() ->
+ true = ets:info(T,fixed),
+ Self ! start,
+ io:put_chars("Starting to filltabstr...\n"),
+ do_tc(fun() ->
+ filltabstr(T, Mult, Mult+10000)
+ end,
+ fun(Elapsed) ->
+ io:format("Done with filltabstr in ~p ms\n",
+ [Elapsed])
+ end),
+ Self ! done
+ end, [link, {scheduler,2}]),
?line start = receive_any(),
- io:format("Unfixing table...~p nitems=~p\n",[now(),ets:info(T,size)]),
- ?line true = ets:safe_fixtable(T,false),
- io:format("Unfix table done. ~p nitems=~p\n",[now(),ets:info(T,size)]),
+ io:format("Unfixing table... nitems=~p\n", [ets:info(T, size)]),
+ do_tc(fun() ->
+ true = ets:safe_fixtable(T, false)
+ end,
+ fun(Elapsed) ->
+ io:format("Unfix table done in ~p ms. nitems=~p\n",
+ [Elapsed,ets:info(T, size)])
+ end),
?line false = ets:info(T,fixed),
?line 0 = get_kept_objects(T),
?line done = receive_any(),
@@ -5158,17 +5162,28 @@ shrink_pseudo_deleted_do(Type) ->
[true]}]),
?line Half = ets:info(T,size),
?line Half = get_kept_objects(T),
- my_spawn_opt(fun()-> ?line true = ets:info(T,fixed),
- Self ! start,
- io:format("Starting to delete... ~p\n",[now()]),
- del_one_by_one_set(T,1,Half+1),
- io:format("Done with delete. ~p\n",[now()]),
- Self ! done
- end, [link, {scheduler,2}]),
+ my_spawn_opt(
+ fun()-> true = ets:info(T,fixed),
+ Self ! start,
+ io:put_chars("Starting to delete... ~p\n"),
+ do_tc(fun() ->
+ del_one_by_one_set(T, 1, Half+1)
+ end,
+ fun(Elapsed) ->
+ io:format("Done with delete in ~p ms.\n",
+ [Elapsed])
+ end),
+ Self ! done
+ end, [link, {scheduler,2}]),
?line start = receive_any(),
- io:format("Unfixing table...~p nitems=~p\n",[now(),ets:info(T,size)]),
- ?line true = ets:safe_fixtable(T,false),
- io:format("Unfix table done. ~p nitems=~p\n",[now(),ets:info(T,size)]),
+ io:format("Unfixing table... nitems=~p\n", [ets:info(T, size)]),
+ do_tc(fun() ->
+ true = ets:safe_fixtable(T, false)
+ end,
+ fun(Elapsed) ->
+ io:format("Unfix table done in ~p ms. nitems=~p\n",
+ [Elapsed,ets:info(T, size)])
+ end),
?line false = ets:info(T,fixed),
?line 0 = get_kept_objects(T),
?line done = receive_any(),
@@ -5321,30 +5336,42 @@ smp_unfix_fix_do() ->
?line Deleted = get_kept_objects(T),
{Child, Mref} =
- my_spawn_opt(fun()-> ?line true = ets:info(T,fixed),
- Parent ! start,
- io:format("Child waiting for table to be unfixed... now=~p mem=~p\n",
- [now(),ets:info(T,memory)]),
- repeat_while(fun()-> ets:info(T,fixed) end),
- io:format("Table unfixed. Child Fixating! now=~p mem=~p\n",
- [now(),ets:info(T,memory)]),
- ?line true = ets:safe_fixtable(T,true),
- repeat_while(fun(Key) when Key =< NumOfObjs ->
- ets:delete(T,Key), {true,Key+1};
- (Key) -> {false,Key}
- end,
- Deleted),
- ?line 0 = ets:info(T,size),
- ?line true = get_kept_objects(T) >= Left,
- ?line done = receive_any()
- end,
- [link, monitor, {scheduler,2}]),
+ my_spawn_opt(
+ fun()->
+ true = ets:info(T,fixed),
+ Parent ! start,
+ io:format("Child waiting for table to be unfixed... mem=~p\n",
+ [ets:info(T, memory)]),
+ do_tc(fun() ->
+ repeat_while(fun()-> ets:info(T, fixed) end)
+ end,
+ fun(Elapsed) ->
+ io:format("Table unfixed in ~p ms."
+ " Child Fixating! mem=~p\n",
+ [Elapsed,ets:info(T,memory)])
+ end),
+ true = ets:safe_fixtable(T,true),
+ repeat_while(fun(Key) when Key =< NumOfObjs ->
+ ets:delete(T,Key), {true,Key+1};
+ (Key) -> {false,Key}
+ end,
+ Deleted),
+ 0 = ets:info(T,size),
+ true = get_kept_objects(T) >= Left,
+ done = receive_any()
+ end,
+ [link, monitor, {scheduler,2}]),
?line start = receive_any(),
?line true = ets:info(T,fixed),
- io:format("Parent starting to unfix... ~p\n",[now()]),
- ets:safe_fixtable(T,false),
- io:format("Parent done with unfix. ~p\n",[now()]),
+ io:put_chars("Parent starting to unfix... ~p\n"),
+ do_tc(fun() ->
+ ets:safe_fixtable(T, false)
+ end,
+ fun(Elapsed) ->
+ io:format("Parent done with unfix in ~p ms.\n",
+ [Elapsed])
+ end),
Child ! done,
{'DOWN', Mref, process, Child, normal} = receive_any(),
?line false = ets:info(T,fixed),
@@ -6346,3 +6373,10 @@ repeat_for_opts_atom2list(compressed) -> [compressed,void].
ets_new(Name, Opts) ->
%%ets:new(Name, [compressed | Opts]).
ets:new(Name, Opts).
+
+do_tc(Do, Report) ->
+ T1 = erlang:monotonic_time(),
+ Do(),
+ T2 = erlang:monotonic_time(),
+ Elapsed = erlang:convert_time_unit(T2 - T1, native, milli_seconds),
+ Report(Elapsed).
diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl
index 576a5adfce..6c28eb00c3 100644
--- a/lib/stdlib/test/gen_event_SUITE.erl
+++ b/lib/stdlib/test/gen_event_SUITE.erl
@@ -131,90 +131,105 @@ start(Config) when is_list(Config) ->
ok.
-hibernate(suite) -> [];
hibernate(Config) when is_list(Config) ->
- ?line {ok,Pid} = gen_event:start({local, my_dummy_handler}),
- ?line ok = gen_event:add_handler(my_dummy_handler, dummy_h, [self()]),
- ?line [dummy_h] = gen_event:which_handlers(my_dummy_handler),
- ?line true = gen_event:call(my_dummy_handler, dummy_h, hibernate),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line Pid ! wake,
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/=
- erlang:process_info(Pid,current_function)),
- ?line later = gen_event:call(my_dummy_handler, dummy_h, hibernate_later),
- ?line true = ({current_function,{erlang,hibernate,3}} =/=
- erlang:process_info(Pid,current_function)),
- ?line receive after 2000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line Pid ! wake,
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/=
- erlang:process_info(Pid,current_function)),
- ?line gen_event:notify(my_dummy_handler,hibernate),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line gen_event:notify(my_dummy_handler,wakeup),
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/=
- erlang:process_info(Pid,current_function)),
- ?line gen_event:notify(my_dummy_handler,hibernate),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line gen_event:sync_notify(my_dummy_handler,wakeup),
- ?line true = ({current_function,{erlang,hibernate,3}} =/=
- erlang:process_info(Pid,current_function)),
- ?line ok = gen_event:sync_notify(my_dummy_handler,hibernate),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line Pid ! wake,
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/=
- erlang:process_info(Pid,current_function)),
- ?line ok = gen_event:add_handler(my_dummy_handler, dummy1_h, [self()]),
- ?line [_,_] = gen_event:which_handlers(my_dummy_handler),
- ?line gen_event:notify(my_dummy_handler,hibernate),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line gen_event:notify(my_dummy_handler,wakeup),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line Pid ! wake,
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/=
- erlang:process_info(Pid,current_function)),
- ?line Pid ! gnurf,
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line Pid ! sleep,
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line Pid ! wake,
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/=
- erlang:process_info(Pid,current_function)),
- ?line ok = gen_event:stop(my_dummy_handler),
- ?line {ok,Pid2} = gen_event:start({local, my_dummy_handler}),
- ?line ok = gen_event:add_handler(my_dummy_handler, dummy_h, [self(),hibernate]),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid2,current_function),
- ?line sys:suspend(my_dummy_handler),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid2,current_function),
- ?line sys:resume(my_dummy_handler),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid2,current_function),
- ?line Pid2 ! wake,
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/=
- erlang:process_info(Pid2,current_function)),
+ {ok,Pid} = gen_event:start({local, my_dummy_handler}),
+ ok = gen_event:add_handler(my_dummy_handler, dummy_h, [self()]),
+ [dummy_h] = gen_event:which_handlers(my_dummy_handler),
+ true = gen_event:call(my_dummy_handler, dummy_h, hibernate),
+ is_in_erlang_hibernate(Pid),
+
+ Pid ! wake,
+ is_not_in_erlang_hibernate(Pid),
+ later = gen_event:call(my_dummy_handler, dummy_h, hibernate_later),
+ true = ({current_function,{erlang,hibernate,3}} =/=
+ erlang:process_info(Pid, current_function)),
+ is_in_erlang_hibernate(Pid),
+
+ Pid ! wake,
+ is_not_in_erlang_hibernate(Pid),
+ gen_event:notify(my_dummy_handler, hibernate),
+ is_in_erlang_hibernate(Pid),
+ gen_event:notify(my_dummy_handler, wakeup),
+ is_not_in_erlang_hibernate(Pid),
+ gen_event:notify(my_dummy_handler, hibernate),
+ is_in_erlang_hibernate(Pid),
+ gen_event:sync_notify(my_dummy_handler, wakeup),
+ true = ({current_function,{erlang,hibernate,3}} =/=
+ erlang:process_info(Pid, current_function)),
+ ok = gen_event:sync_notify(my_dummy_handler, hibernate),
+ is_in_erlang_hibernate(Pid),
+
+ Pid ! wake,
+ is_not_in_erlang_hibernate(Pid),
+ ok = gen_event:add_handler(my_dummy_handler, dummy1_h, [self()]),
+ [_,_] = gen_event:which_handlers(my_dummy_handler),
+ gen_event:notify(my_dummy_handler, hibernate),
+ is_in_erlang_hibernate(Pid),
+ gen_event:notify(my_dummy_handler, wakeup),
+ is_in_erlang_hibernate(Pid),
+
+ Pid ! wake,
+ is_not_in_erlang_hibernate(Pid),
+
+ Pid ! gnurf,
+ is_in_erlang_hibernate(Pid),
+
+ Pid ! sleep,
+ is_in_erlang_hibernate(Pid),
+
+ Pid ! wake,
+ is_not_in_erlang_hibernate(Pid),
+ ok = gen_event:stop(my_dummy_handler),
+
+ {ok,Pid2} = gen_event:start({local, my_dummy_handler}),
+ ok = gen_event:add_handler(my_dummy_handler, dummy_h,
+ [self(),hibernate]),
+ is_in_erlang_hibernate(Pid2),
+ sys:suspend(my_dummy_handler),
+ is_in_erlang_hibernate(Pid2),
+ sys:resume(my_dummy_handler),
+ is_in_erlang_hibernate(Pid2),
+
+ Pid2 ! wake,
+ is_not_in_erlang_hibernate(Pid2),
-
- ?line ok = gen_event:stop(my_dummy_handler),
+ ok = gen_event:stop(my_dummy_handler),
ok.
+is_in_erlang_hibernate(Pid) ->
+ receive after 1 -> ok end,
+ is_in_erlang_hibernate_1(200, Pid).
+
+is_in_erlang_hibernate_1(0, Pid) ->
+ io:format("~p\n", [erlang:process_info(Pid, current_function)]),
+ ?t:fail(not_in_erlang_hibernate_3);
+is_in_erlang_hibernate_1(N, Pid) ->
+ {current_function,MFA} = erlang:process_info(Pid, current_function),
+ case MFA of
+ {erlang,hibernate,3} ->
+ ok;
+ _ ->
+ receive after 10 -> ok end,
+ is_in_erlang_hibernate_1(N-1, Pid)
+ end.
+
+is_not_in_erlang_hibernate(Pid) ->
+ receive after 1 -> ok end,
+ is_not_in_erlang_hibernate_1(200, Pid).
+
+is_not_in_erlang_hibernate_1(0, Pid) ->
+ io:format("~p\n", [erlang:process_info(Pid, current_function)]),
+ ?t:fail(not_in_erlang_hibernate_3);
+is_not_in_erlang_hibernate_1(N, Pid) ->
+ {current_function,MFA} = erlang:process_info(Pid, current_function),
+ case MFA of
+ {erlang,hibernate,3} ->
+ receive after 10 -> ok end,
+ is_not_in_erlang_hibernate_1(N-1, Pid);
+ _ ->
+ ok
+ end.
add_handler(doc) -> [];
diff --git a/lib/stdlib/test/gen_fsm_SUITE.erl b/lib/stdlib/test/gen_fsm_SUITE.erl
index dabc10aec4..f003630535 100644
--- a/lib/stdlib/test/gen_fsm_SUITE.erl
+++ b/lib/stdlib/test/gen_fsm_SUITE.erl
@@ -596,129 +596,123 @@ replace_state(Config) when is_list(Config) ->
ok.
%% Hibernation
-hibernate(suite) -> [];
hibernate(Config) when is_list(Config) ->
OldFl = process_flag(trap_exit, true),
- ?line {ok, Pid0} = gen_fsm:start_link(?MODULE, hiber_now, []),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid0,current_function),
- ?line stop_it(Pid0),
+ {ok, Pid0} = gen_fsm:start_link(?MODULE, hiber_now, []),
+ is_in_erlang_hibernate(Pid0),
+ stop_it(Pid0),
test_server:messages_get(),
-
- ?line {ok, Pid} = gen_fsm:start_link(?MODULE, hiber, []),
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line hibernating = gen_fsm:sync_send_event(Pid,hibernate_sync),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line good_morning = gen_fsm:sync_send_event(Pid,wakeup_sync),
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line hibernating = gen_fsm:sync_send_event(Pid,hibernate_sync),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line five_more = gen_fsm:sync_send_event(Pid,snooze_sync),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line good_morning = gen_fsm:sync_send_event(Pid,wakeup_sync),
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line ok = gen_fsm:send_event(Pid,hibernate_async),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line ok = gen_fsm:send_event(Pid,wakeup_async),
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line ok = gen_fsm:send_event(Pid,hibernate_async),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line ok = gen_fsm:send_event(Pid,snooze_async),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line ok = gen_fsm:send_event(Pid,wakeup_async),
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line Pid ! hibernate_later,
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line receive after 2000 -> ok end,
- ?line ({current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function)),
- ?line 'alive!' = gen_fsm:sync_send_event(Pid,'alive?'),
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line Pid ! hibernate_now,
- ?line receive after 1000 -> ok end,
- ?line ({current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function)),
- ?line 'alive!' = gen_fsm:sync_send_event(Pid,'alive?'),
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
-
-
- ?line hibernating = gen_fsm:sync_send_all_state_event(Pid,hibernate_sync),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line good_morning = gen_fsm:sync_send_all_state_event(Pid,wakeup_sync),
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line hibernating = gen_fsm:sync_send_all_state_event(Pid,hibernate_sync),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line five_more = gen_fsm:sync_send_all_state_event(Pid,snooze_sync),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line good_morning = gen_fsm:sync_send_all_state_event(Pid,wakeup_sync),
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line ok = gen_fsm:send_all_state_event(Pid,hibernate_async),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line ok = gen_fsm:send_all_state_event(Pid,wakeup_async),
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line ok = gen_fsm:send_all_state_event(Pid,hibernate_async),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line ok = gen_fsm:send_all_state_event(Pid,snooze_async),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line ok = gen_fsm:send_all_state_event(Pid,wakeup_async),
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
-
- ?line hibernating = gen_fsm:sync_send_all_state_event(Pid,hibernate_sync),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line sys:suspend(Pid),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line sys:resume(Pid),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
-
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} =
- erlang:process_info(Pid,current_function),
- ?line good_morning = gen_fsm:sync_send_all_state_event(Pid,wakeup_sync),
- ?line receive after 1000 -> ok end,
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line stop_it(Pid),
+ {ok, Pid} = gen_fsm:start_link(?MODULE, hiber, []),
+ true = ({current_function,{erlang,hibernate,3}} =/=
+ erlang:process_info(Pid,current_function)),
+ hibernating = gen_fsm:sync_send_event(Pid, hibernate_sync),
+ is_in_erlang_hibernate(Pid),
+ good_morning = gen_fsm:sync_send_event(Pid, wakeup_sync),
+ is_not_in_erlang_hibernate(Pid),
+ hibernating = gen_fsm:sync_send_event(Pid, hibernate_sync),
+ is_in_erlang_hibernate(Pid),
+ five_more = gen_fsm:sync_send_event(Pid, snooze_sync),
+ is_in_erlang_hibernate(Pid),
+ good_morning = gen_fsm:sync_send_event(Pid, wakeup_sync),
+ is_not_in_erlang_hibernate(Pid),
+ ok = gen_fsm:send_event(Pid, hibernate_async),
+ is_in_erlang_hibernate(Pid),
+ ok = gen_fsm:send_event(Pid, wakeup_async),
+ is_not_in_erlang_hibernate(Pid),
+ ok = gen_fsm:send_event(Pid, hibernate_async),
+ is_in_erlang_hibernate(Pid),
+ ok = gen_fsm:send_event(Pid, snooze_async),
+ is_in_erlang_hibernate(Pid),
+ ok = gen_fsm:send_event(Pid, wakeup_async),
+ is_not_in_erlang_hibernate(Pid),
+
+ Pid ! hibernate_later,
+ true = ({current_function,{erlang,hibernate,3}} =/=
+ erlang:process_info(Pid, current_function)),
+ is_in_erlang_hibernate(Pid),
+
+ 'alive!' = gen_fsm:sync_send_event(Pid,'alive?'),
+ true = ({current_function,{erlang,hibernate,3}} =/=
+ erlang:process_info(Pid, current_function)),
+ Pid ! hibernate_now,
+ is_in_erlang_hibernate(Pid),
+
+ 'alive!' = gen_fsm:sync_send_event(Pid,'alive?'),
+ true = ({current_function,{erlang,hibernate,3}} =/=
+ erlang:process_info(Pid, current_function)),
+
+ hibernating = gen_fsm:sync_send_all_state_event(Pid, hibernate_sync),
+ is_in_erlang_hibernate(Pid),
+ good_morning = gen_fsm:sync_send_all_state_event(Pid, wakeup_sync),
+ is_not_in_erlang_hibernate(Pid),
+ hibernating = gen_fsm:sync_send_all_state_event(Pid, hibernate_sync),
+ is_in_erlang_hibernate(Pid),
+ five_more = gen_fsm:sync_send_all_state_event(Pid, snooze_sync),
+ is_in_erlang_hibernate(Pid),
+ good_morning = gen_fsm:sync_send_all_state_event(Pid, wakeup_sync),
+ is_not_in_erlang_hibernate(Pid),
+ ok = gen_fsm:send_all_state_event(Pid, hibernate_async),
+ is_in_erlang_hibernate(Pid),
+ ok = gen_fsm:send_all_state_event(Pid, wakeup_async),
+ is_not_in_erlang_hibernate(Pid),
+ ok = gen_fsm:send_all_state_event(Pid, hibernate_async),
+ is_in_erlang_hibernate(Pid),
+ ok = gen_fsm:send_all_state_event(Pid, snooze_async),
+ is_in_erlang_hibernate(Pid),
+ ok = gen_fsm:send_all_state_event(Pid, wakeup_async),
+ is_not_in_erlang_hibernate(Pid),
+
+ hibernating = gen_fsm:sync_send_all_state_event(Pid, hibernate_sync),
+ is_in_erlang_hibernate(Pid),
+ sys:suspend(Pid),
+ is_in_erlang_hibernate(Pid),
+ sys:resume(Pid),
+ is_in_erlang_hibernate(Pid),
+ receive after 1000 -> ok end,
+ is_in_erlang_hibernate(Pid),
+
+ good_morning = gen_fsm:sync_send_all_state_event(Pid, wakeup_sync),
+ is_not_in_erlang_hibernate(Pid),
+ stop_it(Pid),
test_server:messages_get(),
process_flag(trap_exit, OldFl),
ok.
+is_in_erlang_hibernate(Pid) ->
+ receive after 1 -> ok end,
+ is_in_erlang_hibernate_1(200, Pid).
+
+is_in_erlang_hibernate_1(0, Pid) ->
+ io:format("~p\n", [erlang:process_info(Pid, current_function)]),
+ ?t:fail(not_in_erlang_hibernate_3);
+is_in_erlang_hibernate_1(N, Pid) ->
+ {current_function,MFA} = erlang:process_info(Pid, current_function),
+ case MFA of
+ {erlang,hibernate,3} ->
+ ok;
+ _ ->
+ receive after 10 -> ok end,
+ is_in_erlang_hibernate_1(N-1, Pid)
+ end.
+is_not_in_erlang_hibernate(Pid) ->
+ receive after 1 -> ok end,
+ is_not_in_erlang_hibernate_1(200, Pid).
+
+is_not_in_erlang_hibernate_1(0, Pid) ->
+ io:format("~p\n", [erlang:process_info(Pid, current_function)]),
+ ?t:fail(not_in_erlang_hibernate_3);
+is_not_in_erlang_hibernate_1(N, Pid) ->
+ {current_function,MFA} = erlang:process_info(Pid, current_function),
+ case MFA of
+ {erlang,hibernate,3} ->
+ receive after 10 -> ok end,
+ is_not_in_erlang_hibernate_1(N-1, Pid);
+ _ ->
+ ok
+ end.
%%sys1(suite) -> [];
%%sys1(_) ->
diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl
index 30dabf63c5..66341f495f 100644
--- a/lib/stdlib/test/gen_server_SUITE.erl
+++ b/lib/stdlib/test/gen_server_SUITE.erl
@@ -641,15 +641,13 @@ info(Config) when is_list(Config) ->
end,
ok.
-hibernate(suite) -> [];
hibernate(Config) when is_list(Config) ->
OldFl = process_flag(trap_exit, true),
- ?line {ok, Pid0} =
+ {ok, Pid0} =
gen_server:start_link({local, my_test_name_hibernate0},
- gen_server_SUITE, hibernate, []),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid0,current_function),
- ?line ok = gen_server:call(my_test_name_hibernate0, stop),
+ gen_server_SUITE, hibernate, []),
+ is_in_erlang_hibernate(Pid0),
+ ok = gen_server:call(my_test_name_hibernate0, stop),
receive
{'EXIT', Pid0, stopped} ->
ok
@@ -657,70 +655,66 @@ hibernate(Config) when is_list(Config) ->
test_server:fail(gen_server_did_not_die)
end,
- ?line {ok, Pid} =
+ {ok, Pid} =
gen_server:start_link({local, my_test_name_hibernate},
- gen_server_SUITE, [], []),
+ gen_server_SUITE, [], []),
- ?line ok = gen_server:call(my_test_name_hibernate, started_p),
- ?line true = gen_server:call(my_test_name_hibernate, hibernate),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line Parent = self(),
+ ok = gen_server:call(my_test_name_hibernate, started_p),
+ true = gen_server:call(my_test_name_hibernate, hibernate),
+ is_in_erlang_hibernate(Pid),
+ Parent = self(),
Fun = fun() ->
- receive
- go ->
- ok
- end,
- receive
- after 1000 ->
- ok
- end,
- X = erlang:process_info(Pid,current_function),
+ receive go -> ok end,
+ receive after 1000 -> ok end,
+ X = erlang:process_info(Pid, current_function),
Pid ! continue,
Parent ! {result,X}
end,
- ?line Pid2 = spawn_link(Fun),
- ?line true = gen_server:call(my_test_name_hibernate, {hibernate_noreply,Pid2}),
-
- ?line gen_server:cast(my_test_name_hibernate, hibernate_later),
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line receive after 2000 -> ok end,
- ?line ({current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function)),
- ?line ok = gen_server:call(my_test_name_hibernate, started_p),
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line gen_server:cast(my_test_name_hibernate, hibernate_now),
- ?line receive after 1000 -> ok end,
- ?line ({current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function)),
- ?line ok = gen_server:call(my_test_name_hibernate, started_p),
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line Pid ! hibernate_later,
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line receive after 2000 -> ok end,
- ?line ({current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function)),
- ?line ok = gen_server:call(my_test_name_hibernate, started_p),
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line Pid ! hibernate_now,
- ?line receive after 1000 -> ok end,
- ?line ({current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function)),
- ?line ok = gen_server:call(my_test_name_hibernate, started_p),
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
- ?line receive
- {result,R} ->
- ?line {current_function,{erlang,hibernate,3}} = R
- end,
- ?line true = gen_server:call(my_test_name_hibernate, hibernate),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line sys:suspend(my_test_name_hibernate),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line sys:resume(my_test_name_hibernate),
- ?line receive after 1000 -> ok end,
- ?line {current_function,{erlang,hibernate,3}} = erlang:process_info(Pid,current_function),
- ?line ok = gen_server:call(my_test_name_hibernate, started_p),
- ?line true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
-
- ?line ok = gen_server:call(my_test_name_hibernate, stop),
+ Pid2 = spawn_link(Fun),
+ true = gen_server:call(my_test_name_hibernate, {hibernate_noreply,Pid2}),
+
+ gen_server:cast(my_test_name_hibernate, hibernate_later),
+ true = ({current_function,{erlang,hibernate,3}} =/=
+ erlang:process_info(Pid, current_function)),
+ is_in_erlang_hibernate(Pid),
+ ok = gen_server:call(my_test_name_hibernate, started_p),
+ true = ({current_function,{erlang,hibernate,3}} =/=
+ erlang:process_info(Pid, current_function)),
+
+ gen_server:cast(my_test_name_hibernate, hibernate_now),
+ is_in_erlang_hibernate(Pid),
+ ok = gen_server:call(my_test_name_hibernate, started_p),
+ true = ({current_function,{erlang,hibernate,3}} =/=
+ erlang:process_info(Pid, current_function)),
+
+ Pid ! hibernate_later,
+ true = ({current_function,{erlang,hibernate,3}} =/=
+ erlang:process_info(Pid, current_function)),
+ is_in_erlang_hibernate(Pid),
+ ok = gen_server:call(my_test_name_hibernate, started_p),
+ true = ({current_function,{erlang,hibernate,3}} =/=
+ erlang:process_info(Pid, current_function)),
+
+ Pid ! hibernate_now,
+ is_in_erlang_hibernate(Pid),
+ ok = gen_server:call(my_test_name_hibernate, started_p),
+ true = ({current_function,{erlang,hibernate,3}} =/=
+ erlang:process_info(Pid, current_function)),
+ receive
+ {result,R} ->
+ {current_function,{erlang,hibernate,3}} = R
+ end,
+
+ true = gen_server:call(my_test_name_hibernate, hibernate),
+ is_in_erlang_hibernate(Pid),
+ sys:suspend(my_test_name_hibernate),
+ is_in_erlang_hibernate(Pid),
+ sys:resume(my_test_name_hibernate),
+ is_in_erlang_hibernate(Pid),
+ ok = gen_server:call(my_test_name_hibernate, started_p),
+ true = ({current_function,{erlang,hibernate,3}} =/= erlang:process_info(Pid,current_function)),
+
+ ok = gen_server:call(my_test_name_hibernate, stop),
receive
{'EXIT', Pid, stopped} ->
ok
@@ -730,6 +724,23 @@ hibernate(Config) when is_list(Config) ->
process_flag(trap_exit, OldFl),
ok.
+is_in_erlang_hibernate(Pid) ->
+ receive after 1 -> ok end,
+ is_in_erlang_hibernate_1(200, Pid).
+
+is_in_erlang_hibernate_1(0, Pid) ->
+ io:format("~p\n", [erlang:process_info(Pid, current_function)]),
+ ?t:fail(not_in_erlang_hibernate_3);
+is_in_erlang_hibernate_1(N, Pid) ->
+ {current_function,MFA} = erlang:process_info(Pid, current_function),
+ case MFA of
+ {erlang,hibernate,3} ->
+ ok;
+ _ ->
+ receive after 10 -> ok end,
+ is_in_erlang_hibernate_1(N-1, Pid)
+ end.
+
%% --------------------------------------
%% Test gen_server:abcast and handle_cast.
%% Test all different return values from
diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl
index c55836ff87..858a78b1d2 100644
--- a/lib/stdlib/test/io_proto_SUITE.erl
+++ b/lib/stdlib/test/io_proto_SUITE.erl
@@ -476,149 +476,182 @@ unicode_options(Config) when is_list(Config) ->
ok.
-unicode_options_gen(suite) ->
- [];
-unicode_options_gen(doc) ->
- ["Tests various unicode options on random generated files"];
+%% Tests various unicode options on random generated files.
unicode_options_gen(Config) when is_list(Config) ->
- ?line random:seed(1240,900586,553728),
- ?line PrivDir = ?config(priv_dir,Config),
- ?line AllModes = [utf8,utf16,{utf16,big},{utf16,little},utf32,{utf32,big},{utf32,little}],
- ?line FSize = 17*1024,
- ?line NumItersRead = 2,
- ?line NumItersWrite = 2,
- ?line Dir = filename:join([PrivDir,"GENDATA1"]),
- ?line file:make_dir(Dir),
-
- %dbg:tracer(process,{fun(A,_) -> erlang:display(A) end,true}),
- %dbg:tpl(file_io_server,x),
- %dbg:ctpl(file_io_server,cafu),
- %dbg:tp(unicode,x),
-
- DoOneFile1 = fun(Encoding,N,M) ->
- ?dbg({Encoding,M,N}),
- io:format("Read test: Encoding ~p, Chunk size ~p, Iteration ~p~n",[Encoding,M,N]),
- io:format(standard_error,"Read test: Encoding ~p, Chunk size ~p, Iteration ~p\r\n",[Encoding,M,N]),
- ?line Fname = filename:join([Dir,"genfile_"++enc2str(Encoding)++"_"++integer_to_list(N)]),
- ?dbg(?LINE),
- ?line Ulist = random_unicode(FSize),
- ?dbg(?LINE),
- ?line my_write_file(Fname,Ulist,Encoding),
- ?dbg(?LINE),
- ?line {ok,F1} = file:open(Fname,[read,{encoding,Encoding}]),
-
- ?dbg(?LINE),
- ?line Res1 = read_whole_file(fun(FD) -> io:get_line(FD,'') end,F1),
- ?dbg(?LINE),
- ?line Ulist = unicode:characters_to_list(Res1,unicode),
- ?dbg(?LINE),
- ?line file:close(F1),
- ?line {ok,F2} = file:open(Fname, [read,binary,{encoding,Encoding}]),
- ?line Res2 = read_whole_file(fun(FD) -> io:get_chars(FD,'',M) end,F2),
- ?line Ulist = unicode:characters_to_list(Res2,unicode),
- ?dbg(?LINE),
- ?line file:close(F2),
- ?line {ok,F3} = file:open(Fname, [read,binary,{encoding,Encoding}]),
- ?dbg(?LINE),
-%% case {Encoding,M,N} of
-%% {{utf16,little},10,2} ->
-%% dbg:p(F3,call);
-%% _ ->
-%% ok
-%% end,
-
- ?line Res3 = read_whole_file(fun(FD) -> case io:fread(FD,'',"~ts") of {ok,D} -> D; O -> O end end, F3),
- ?dbg(?LINE),
- ?line Ulist2 = [ X || X <- Ulist,
- X =/= $\n, X =/= $ ],
- ?dbg(?LINE),
- ?line Ulist2 = unicode:characters_to_list(Res3,unicode),
- ?dbg(?LINE),
- ?line file:close(F3),
- ?line {ok,F4} = file:open(Fname, [read,{encoding,Encoding}]),
- ?line Res4 = read_whole_file(fun(FD) -> case io:fread(FD,'',"~tc") of {ok,D} -> D; O -> O end end,F4),
- ?line Ulist3 = [ X || X <- Ulist,
- X =/= $\n ],
- ?line Ulist3 = unicode:characters_to_list(Res4,unicode),
- ?dbg(?LINE),
- ?line file:close(F4),
- ?line file:delete(Fname)
- end,
-
- [ [ [ DoOneFile1(E,N,M) || E <- AllModes ] || M <- [10,1000,128,1024,8192,8193] ] || N <- lists:seq(1,NumItersRead)],
- DoOneFile2 = fun(Encoding,N,M) ->
- ?dbg({Encoding,M,N}),
- io:format("Write test: Encoding ~p, Chunk size ~p, Iteration ~p~n",[Encoding,M,N]),
- io:format(standard_error,"Write test: Encoding ~p, Chunk size ~p, Iteration ~p\r\n",[Encoding,M,N]),
- ?line Fname = filename:join([Dir,"genfile_"++enc2str(Encoding)++"_"++integer_to_list(N)]),
- ?dbg(?LINE),
- ?line Ulist = random_unicode(FSize),
- ?dbg(?LINE),
- ?line {ok,F1} = file:open(Fname,[write,{encoding,Encoding}]),
- ?line io:put_chars(F1,Ulist),
- ?line file:close(F1),
- ?line Ulist = my_read_file(Fname,Encoding),
- ?line file:delete(Fname),
- ?line {ok,F2} = file:open(Fname,[write,binary,{encoding,Encoding}]),
- ?line io:put_chars(F2,Ulist),
- ?line file:close(F2),
- ?line Ulist = my_read_file(Fname,Encoding),
- ?line file:delete(Fname),
- ?line {ok,F3} = file:open(Fname,[write,{encoding,Encoding}]),
- ?line LL = string:tokens(Ulist,"\n"),
- ?line Ulist2 = lists:flatten(LL),
- ?line [ io:format(F3,"~ts",[L]) || L <- LL ],
- ?line file:close(F3),
- ?line Ulist2 = my_read_file(Fname,Encoding),
- ?line file:delete(Fname),
- ?line {ok,F4} = file:open(Fname,[write,{encoding,Encoding}]),
- ?line [ io:format(F4,"~tc",[C]) || C <- Ulist ],
- ?line file:close(F4),
- ?line Ulist = my_read_file(Fname,Encoding),
- ?line file:delete(Fname),
- ?line {ok,F5} = file:open(Fname,[write,{encoding,Encoding}]),
- ?line io:put_chars(F5,unicode:characters_to_binary(Ulist)),
- ?line file:close(F5),
- ?line Ulist = my_read_file(Fname,Encoding),
- ?line file:delete(Fname),
- ok
- end,
- [ [ [ DoOneFile2(E,N,M) || E <- AllModes ] || M <- [10,1000,128,1024,8192,8193] ] || N <- lists:seq(1,NumItersWrite)],
+ random:seed(1240, 900586, 553728),
+ PrivDir = ?config(priv_dir, Config),
+ AllModes = [utf8,utf16,{utf16,big},{utf16,little},
+ utf32,{utf32,big},{utf32,little}],
+ FSize = 17*1024,
+ NumItersRead = 2,
+ NumItersWrite = 2,
+ Dir = filename:join(PrivDir, "GENDATA1"),
+ file:make_dir(Dir),
+
+ DoOneFile1 =
+ fun(Encoding, N, M) ->
+ ?dbg({Encoding,M,N}),
+ io:format("Read test: Encoding ~p, Chunk size ~p, Iteration ~p~n",[Encoding,M,N]),
+ io:format(standard_error,
+ "Read test: Encoding ~p, Chunk size ~p, Iteration ~p\r\n",[Encoding,M,N]),
+ Fname = filename:join(Dir,
+ "genfile_"++enc2str(Encoding)++
+ "_"++integer_to_list(N)),
+ Ulist = random_unicode(FSize),
+ Bin = unicode:characters_to_binary(Ulist, utf8, Encoding),
+ ok = file:write_file(Fname, Bin),
+
+ Read1 = fun(FD) -> io:get_line(FD, '') end,
+ Res1 = read_whole_file(Fname,
+ [read,read_ahead,{encoding,Encoding}],
+ Read1),
+
+ Read2 = fun(FD) -> io:get_chars(FD, '', M) end,
+ Res2 = read_whole_file(Fname,
+ [read,binary,
+ read_ahead,{encoding,Encoding}],
+ Read2),
+
+ Read3 = fun(FD) ->
+ case io:fread(FD, '', "~ts") of
+ {ok,D} -> D;
+ Other -> Other end
+ end,
+ Res3 = read_whole_file(Fname,
+ [read,binary,
+ read_ahead,{encoding,Encoding}],
+ Read3),
+
+ Read4 = fun(FD) ->
+ case io:fread(FD, '', "~ts") of
+ {ok,D} -> D;
+ Other -> Other end
+ end,
+ Res4 = read_whole_file(Fname,
+ [read,read_ahead,{encoding,Encoding}],
+ Read4),
+
+ Ulist2 = [X || X <- Ulist, X =/= $\n, X =/= $\s],
+ Ulist3 = [X || X <- Ulist, X =/= $\n],
+ Ulist = done(Res1),
+ Ulist = done(Res2),
+ Ulist2 = done(Res3),
+ Ulist3 = done(Res4),
+
+ file:delete(Fname)
+ end,
+ [ [ [ DoOneFile1(E, N, M) || E <- AllModes ] ||
+ M <- [10,1000,128,1024,8192,8193] ] ||
+ N <- lists:seq(1, NumItersRead) ],
+
+ DoOneFile2 =
+ fun(Encoding,N,M) ->
+ ?dbg({Encoding,M,N}),
+ io:format("Write test: Encoding ~p, Chunk size ~p, Iteration ~p~n",[Encoding,M,N]),
+ io:format(standard_error,
+ "Write test: Encoding ~p, Chunk size ~p, Iteration ~p\r\n",[Encoding,M,N]),
+ Fname = filename:join(Dir,
+ "genfile_"++enc2str(Encoding)++
+ "_"++integer_to_list(N)),
+ Ulist = random_unicode(FSize),
+
+ Res1 = write_read_file(Fname, 1,
+ [write],
+ Encoding,
+ fun(FD) -> io:put_chars(FD, Ulist) end),
+
+ Res2 = write_read_file(Fname, 2,
+ [write,binary],
+ Encoding,
+ fun(FD) -> io:put_chars(FD, Ulist) end),
+
+ Fun3 = fun(FD) ->
+ _ = [io:format(FD, "~tc", [C]) || C <- Ulist],
+ ok
+ end,
+ Res3 = write_read_file(Fname, 3,
+ [write],
+ Encoding,
+ Fun3),
+
+ Fun4 = fun(FD) ->
+ io:put_chars(FD,
+ unicode:characters_to_binary(Ulist))
+ end,
+ Res4 = write_read_file(Fname, 4,
+ [write],
+ Encoding,
+ Fun4),
+
+ LL = string:tokens(Ulist, "\n"),
+ Fun5 = fun(FD) ->
+ _ = [io:format(FD, "~ts", [L]) || L <- LL],
+ ok
+ end,
+ Res5 = write_read_file(Fname, 5,
+ [write],
+ Encoding,
+ Fun5),
+
+ Ulist2 = lists:flatten(LL),
+ ResBin = done(Res1),
+ ResBin = done(Res2),
+ ResBin = done(Res3),
+ ResBin = done(Res4),
+ Ulist = unicode:characters_to_list(ResBin, Encoding),
+
+ ResBin2 = done(Res5),
+ Ulist2 = unicode:characters_to_list(ResBin2, Encoding),
+
+ ok
+ end,
+ [ [ [ DoOneFile2(E, N, M) || E <- AllModes ] ||
+ M <- [10,1000,128,1024,8192,8193] ] ||
+ N <- lists:seq(1, NumItersWrite) ],
ok.
+read_whole_file(Fname, Options, Fun) ->
+ do(fun() ->
+ do_read_whole_file(Fname, Options, Fun)
+ end).
+do_read_whole_file(Fname, Options, Fun) ->
+ {ok,F} = file:open(Fname, Options),
+ Res = do_read_whole_file_1(Fun, F),
+ ok = file:close(F),
+ unicode:characters_to_list(Res, unicode).
-
-read_whole_file(Fun,F) ->
+do_read_whole_file_1(Fun, F) ->
case Fun(F) of
eof ->
[];
{error,Error} ->
- ?dbg(Error),
receive after 10000 -> ok end,
exit(Error);
Other ->
- %?dbg(Other),
- [Other | read_whole_file(Fun,F)]
+ [Other|do_read_whole_file_1(Fun, F)]
end.
-
+write_read_file(Fname0, N, Options, Enc, Writer) ->
+ Fname = Fname0 ++ "_" ++ integer_to_list(N),
+ do(fun() ->
+ do_write_read_file(Fname, Options, Enc, Writer)
+ end).
+
+do_write_read_file(Fname, Options, Encoding, Writer) ->
+ {ok,F} = file:open(Fname, [{encoding,Encoding}|Options]),
+ Writer(F),
+ ok = file:close(F),
+ {ok,Bin} = file:read_file(Fname),
+ ok = file:delete(Fname),
+ Bin.
+
enc2str(Atom) when is_atom(Atom) ->
atom_to_list(Atom);
enc2str({A1,A2}) when is_atom(A1), is_atom(A2) ->
atom_to_list(A1)++"_"++atom_to_list(A2).
-
-
-my_write_file(Filename,UniList,Encoding) ->
- Bin = unicode:characters_to_binary(UniList,utf8,Encoding),
- file:write_file(Filename,Bin).
-
-my_read_file(Filename,Encoding) ->
- {ok,Bin} = file:read_file(Filename),
- unicode:characters_to_list(Bin,Encoding).
-
random_unicode(0) ->
[];
random_unicode(N) ->
@@ -1733,8 +1766,7 @@ toerl_loop(Port,Acc) ->
end.
millistamp() ->
- {Mega, Secs, Micros} = erlang:now(),
- (Micros div 1000) + Secs * 1000 + Mega * 1000000000.
+ erlang:monotonic_time(milli_seconds).
get_data_within(Port, X, Acc) when X =< 0 ->
?dbg({get_data_within, X, Acc, ?LINE}),
@@ -1932,3 +1964,15 @@ chomp(<<Ch,Rest/binary>>) ->
<<Ch,X/binary>>;
chomp(Atom) ->
Atom.
+
+do(Fun) ->
+ {_,Ref} = spawn_monitor(fun() ->
+ exit(Fun())
+ end),
+ Ref.
+
+done(Ref) ->
+ receive
+ {'DOWN',Ref,process,_,Result} ->
+ Result
+ end.
diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl
index f4589a8e24..01c138d94c 100644
--- a/lib/stdlib/test/lists_SUITE.erl
+++ b/lib/stdlib/test/lists_SUITE.erl
@@ -1704,7 +1704,7 @@ fun_pid(Fun) ->
get_seed() ->
case random:seed() of
undefined ->
- now();
+ erlang:timestamp();
Tuple ->
Tuple
end.
diff --git a/lib/stdlib/test/random_SUITE.erl b/lib/stdlib/test/random_SUITE.erl
index ac9d1a6c06..22c0900651 100644
--- a/lib/stdlib/test/random_SUITE.erl
+++ b/lib/stdlib/test/random_SUITE.erl
@@ -82,7 +82,7 @@ seed(suite) ->
[];
seed(Config) when is_list(Config) ->
?line Self = self(),
- ?line Seed = {S1, S2, S3} = now(),
+ Seed = {S1, S2, S3} = erlang:timestamp(),
?line _ = spawn(fun() ->
random:seed(S1,S2,S3),
Rands = lists:foldl(fun
diff --git a/lib/stdlib/test/select_SUITE.erl b/lib/stdlib/test/select_SUITE.erl
index 546c25f954..201c38b25a 100644
--- a/lib/stdlib/test/select_SUITE.erl
+++ b/lib/stdlib/test/select_SUITE.erl
@@ -211,7 +211,7 @@ init_random(Config) ->
{ok,[X]} ->
X;
_ ->
- {A,B,C} = erlang:now(),
+ {A,B,C} = erlang:timestamp(),
random:seed(A,B,C),
get(random_seed)
end,
diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl
index a55c710d50..e9ea2e3522 100644
--- a/lib/stdlib/test/string_SUITE.erl
+++ b/lib/stdlib/test/string_SUITE.erl
@@ -120,7 +120,7 @@ chr_rchr(suite) ->
chr_rchr(doc) ->
[];
chr_rchr(Config) when is_list(Config) ->
- ?line {_,_,X} = now(),
+ {_,_,X} = erlang:timestamp(),
?line 0 = string:chr("", (X rem (255-32)) + 32),
?line 0 = string:rchr("", (X rem (255-32)) + 32),
?line 1 = string:chr("x", $x),
@@ -144,7 +144,7 @@ str_rstr(suite) ->
str_rstr(doc) ->
[];
str_rstr(Config) when is_list(Config) ->
- ?line {_,_,X} = now(),
+ {_,_,X} = erlang:timestamp(),
?line 0 = string:str("", [(X rem (255-32)) + 32]),
?line 0 = string:rstr("", [(X rem (255-32)) + 32]),
?line 1 = string:str("x", "x"),
diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl
index 9b6d65011e..3b54cd0f34 100644
--- a/lib/stdlib/test/tar_SUITE.erl
+++ b/lib/stdlib/test/tar_SUITE.erl
@@ -89,7 +89,7 @@ borderline_test(Size, TempDir) ->
?line io:format("Testing size ~p", [Size]),
%% Create a file and archive it.
- ?line {_, _, X0} = erlang:now(),
+ X0 = erlang:monotonic_time(),
?line file:write_file(Name, random_byte_list(X0, Size)),
?line ok = erl_tar:create(Archive, [Name]),
?line ok = file:delete(Name),
diff --git a/lib/stdlib/test/timer_SUITE.erl b/lib/stdlib/test/timer_SUITE.erl
index bea2b3fb2a..ae32d98807 100644
--- a/lib/stdlib/test/timer_SUITE.erl
+++ b/lib/stdlib/test/timer_SUITE.erl
@@ -25,14 +25,11 @@
-include_lib("test_server/include/test_server.hrl").
-%% Test suite for timer module. This is a really nasty test it runs a
-%% lot of timeouts and then checks in the end if any of them was
-%% trigggered too early or if any late timeouts was much too
-%% late. What should be added is more testing of the interface
-%% functions I guess. But I don't have time for that now.
+%% Random test of the timer module. This is a really nasty test, as it
+%% runs a lot of timeouts and then checks in the end if any of them
+%% was triggered too early or if any late timeouts was much too late.
%%
-%% Expect it to run for at least 5-10 minutes!
-
+%% Running time on average is about 90 seconds.
%% The main test case in this module is "do_big_test", which
%% orders a large number of timeouts and measures how
@@ -40,15 +37,8 @@
%% also a number of other concurrent processes running "nrev" at the same
%% time. The result is analyzed afterwards by trying to check if the
%% measured values are reasonable. It is hard to determine what is
-%% reasonable on different machines therefore the test can sometimes
-%% fail, even though the timer module is ok. I have checked against
-%% previous versions of the timer module (which contained bugs) and it
-%% seems it fails every time when running the buggy timer modules.
-%%
-%% The solution is to rewrite the test suite. Possible strategies for a
-%% rewrite: smarter math on the measuring data, test cases with varying
-%% amount of load. The test suite should also include tests that test the
-%% interface of the timer module.
+%% reasonable on different machines; therefore the test can sometimes
+%% fail, even though the timer module is ok.
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -89,10 +79,7 @@ report_result(Error) -> ?line test_server:fail(Error).
big_test(N) ->
C = start_collect(),
system_time(), system_time(), system_time(),
- A1 = element(2, erlang:now()),
- A2 = A1 * 3,
- A3 = element(3, erlang:now()),
- random:seed(A1, A2, A3),
+ random:seed(erlang:timestamp()),
random:uniform(100),random:uniform(100),random:uniform(100),
big_loop(C, N, []),
@@ -146,7 +133,7 @@ big_loop(C, N, Pids) ->
%%Pids2=Pids1,
%% wait a little while
- timer:sleep(random:uniform(200)*10),
+ timer:sleep(random:uniform(200)*3),
%% spawn zero, one or two nrev to get some load ;-/
Pids3 = start_nrev(Pids2, random:uniform(100)),
@@ -166,14 +153,14 @@ start_nrev(Pids, _N) ->
start_after_test(Pids, C, 1) ->
- TO1 = random:uniform(100)*100,
+ TO1 = random:uniform(100)*47,
[s_a_t(C, TO1)|Pids];
start_after_test(Pids, C, 2) ->
- TO1 = random:uniform(100)*100,
- TO2 = TO1 div random:uniform(3) + 200,
+ TO1 = random:uniform(100)*47,
+ TO2 = TO1 div random:uniform(3) + 101,
[s_a_t(C, TO1),s_a_t(C, TO2)|Pids];
start_after_test(Pids, C, N) ->
- TO1 = random:uniform(100)*100,
+ TO1 = random:uniform(100)*47,
start_after_test([s_a_t(C, TO1)|Pids], C, N-1).
s_a_t(C, TimeOut) ->
@@ -199,7 +186,7 @@ a_t(C, TimeOut) ->
maybe_start_i_test(Pids, C, 1) ->
%% ok do it
- TOI = random:uniform(100)*100,
+ TOI = random:uniform(53)*49,
CountI = random:uniform(10) + 3, % at least 4 times
[spawn_link(timer_SUITE, i_t, [C, TOI, CountI])|Pids];
maybe_start_i_test(Pids, _C, _) ->
@@ -374,9 +361,7 @@ res_combine({error,Es}, [{error,E}|T]) ->
system_time() ->
- %%element(1, statistics(wall_clock)).
- {M,S,U} = erlang:now(),
- 1000000000 * M + 1000 * S + (U div 1000).
+ erlang:monotonic_time(milli_seconds).
%% ------------------------------------------------------- %%
diff --git a/lib/stdlib/test/timer_simple_SUITE.erl b/lib/stdlib/test/timer_simple_SUITE.erl
index dc751aad16..3c7e3c5f25 100644
--- a/lib/stdlib/test/timer_simple_SUITE.erl
+++ b/lib/stdlib/test/timer_simple_SUITE.erl
@@ -374,7 +374,6 @@ performance(Mod) ->
big_test(M) ->
Load_Pids = start_nrev(20, M), % Increase if more load wanted :)
- apply(M, sleep, [9000]),
LPids = spawn_timers(5, M, 10000, 5),
apply(M, sleep, [4000]),
@@ -483,8 +482,7 @@ append([],X) ->
X.
system_time() ->
- {M,S,U} = erlang:now(),
- 1000000*(M*1000000 + S) + U.
+ erlang:monotonic_time(micro_seconds).
%% ------------------------------------------------------- %%
diff --git a/lib/stdlib/test/unicode_SUITE.erl b/lib/stdlib/test/unicode_SUITE.erl
index 10b29d0d28..613be99ccd 100644
--- a/lib/stdlib/test/unicode_SUITE.erl
+++ b/lib/stdlib/test/unicode_SUITE.erl
@@ -29,7 +29,13 @@
random_lists/1,
roundtrips/1,
latin1/1,
- exceptions/1, binaries_errors/1]).
+ exceptions/1,
+ binaries_errors_limit/1,
+ ex_binaries_errors_utf8/1,
+ ex_binaries_errors_utf16_little/1,
+ ex_binaries_errors_utf16_big/1,
+ ex_binaries_errors_utf32_little/1,
+ ex_binaries_errors_utf32_big/1]).
init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog=?t:timetrap(?t:minutes(20)),
@@ -44,10 +50,17 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
[utf8_illegal_sequences_bif,
utf16_illegal_sequences_bif, random_lists, roundtrips,
- latin1, exceptions, binaries_errors].
+ latin1, exceptions,
+ binaries_errors_limit,
+ {group,binaries_errors}].
groups() ->
- [].
+ [{binaries_errors,[parallel],
+ [ex_binaries_errors_utf8,
+ ex_binaries_errors_utf16_little,
+ ex_binaries_errors_utf16_big,
+ ex_binaries_errors_utf32_little,
+ ex_binaries_errors_utf32_big]}].
init_per_suite(Config) ->
Config.
@@ -61,15 +74,11 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-binaries_errors(Config) when is_list(Config) ->
+binaries_errors_limit(Config) when is_list(Config) ->
setlimit(10),
ex_binaries_errors_utf8(Config),
setlimit(default),
- ex_binaries_errors_utf8(Config),
- ex_binaries_errors_utf16_little(Config),
- ex_binaries_errors_utf16_big(Config),
- ex_binaries_errors_utf32_little(Config),
- ex_binaries_errors_utf32_big(Config).
+ ok.
ex_binaries_errors_utf8(Config) when is_list(Config) ->
%% Original smoke test, we should not forget the original offset...
@@ -102,109 +111,84 @@ ex_binaries_errors_utf8(Config) when is_list(Config) ->
ok.
ex_binaries_errors_utf16_little(Config) when is_list(Config) ->
- BrokenPart = << <<X:16/little>> || X <- lists:seq(16#DC00,16#DFFF) >>,
- BrokenSz = byte_size(BrokenPart),
- [ begin
- OKList = lists:flatten(lists:duplicate(N,lists:seq(1,255))),
- OKBin = unicode:characters_to_binary(OKList,unicode,{utf16,little}),
- OKLen = length(OKList),
- %% Copy to avoid that the binary get's writable
- PartlyBroken = binary:copy(<<OKBin/binary, BrokenPart/binary>>),
- PBSz = byte_size(PartlyBroken),
- {error,OKList,DeepBrokenPart} =
- unicode:characters_to_list(PartlyBroken,{utf16,little}),
- BrokenPart = iolist_to_binary(DeepBrokenPart),
- [ begin
- NewList = lists:nthtail(X, OKList),
- NewSz = byte_size(unicode:characters_to_binary(NewList,unicode,{utf16,little})) +
- BrokenSz,
- Chomped = binary:part(PartlyBroken,PBSz - NewSz, NewSz),
- true = (binary:referenced_byte_size(Chomped) =:= PBSz),
- {error,NewList,DeepBrokenPart2} =
- unicode:characters_to_list(Chomped,{utf16,little}),
- BrokenPart = iolist_to_binary(DeepBrokenPart2)
- end || X <- lists:seq(1,OKLen) ]
- end || N <- lists:seq(1,16,3) ],
- ok.
+ ex_binaries_errors_utf16(little).
+
ex_binaries_errors_utf16_big(Config) when is_list(Config) ->
- BrokenPart = << <<X:16/big>> || X <- lists:seq(16#DC00,16#DFFF) >>,
+ ex_binaries_errors_utf16(big).
+
+ex_binaries_errors_utf16(Endian) ->
+ BrokenSeq = lists:seq(16#DC00, 16#DFFF),
+ BrokenPart = case Endian of
+ little ->
+ << <<X:16/little>> || X <- BrokenSeq >>;
+ big ->
+ << <<X:16/big>> || X <- BrokenSeq >>
+ end,
BrokenSz = byte_size(BrokenPart),
+ Seq255 = lists:seq(1, 255),
[ begin
- OKList = lists:flatten(lists:duplicate(N,lists:seq(1,255))),
- OKBin = unicode:characters_to_binary(OKList,unicode,{utf16,big}),
- OKLen = length(OKList),
- %% Copy to avoid that the binary get's writable
- PartlyBroken = binary:copy(<<OKBin/binary, BrokenPart/binary>>),
+ OKList = lists:append(lists:duplicate(N, Seq255)),
+ OKBin = unicode:characters_to_binary(OKList, unicode, {utf16,Endian}),
+ PartlyBroken = iolist_to_binary([OKBin,BrokenPart]),
PBSz = byte_size(PartlyBroken),
{error,OKList,DeepBrokenPart} =
- unicode:characters_to_list(PartlyBroken,{utf16,big}),
+ unicode:characters_to_list(PartlyBroken, {utf16,Endian}),
BrokenPart = iolist_to_binary(DeepBrokenPart),
- [ begin
- NewList = lists:nthtail(X, OKList),
- NewSz = byte_size(unicode:characters_to_binary(NewList,unicode,{utf16,big})) +
- BrokenSz,
- Chomped = binary:part(PartlyBroken,PBSz - NewSz, NewSz),
- true = (binary:referenced_byte_size(Chomped) =:= PBSz),
- {error,NewList,DeepBrokenPart2} =
- unicode:characters_to_list(Chomped,{utf16,big}),
- BrokenPart = iolist_to_binary(DeepBrokenPart2)
- end || X <- lists:seq(1,OKLen) ]
- end || N <- lists:seq(1,16,3) ],
+ utf16_inner_loop(OKList, BrokenPart, BrokenSz,
+ PartlyBroken, PBSz, Endian)
+ end || N <- lists:seq(1, 16, 3) ],
+ ok.
+
+utf16_inner_loop([_|List], BrokenPart, BrokenSz, PartlyBroken, PBSz, Endian) ->
+ Sz = length(List)*2 + BrokenSz,
+ Chomped = binary:part(PartlyBroken, PBSz - Sz, Sz),
+ true = binary:referenced_byte_size(Chomped) =:= PBSz,
+ {error,List,DeepBrokenPart} =
+ unicode:characters_to_list(Chomped, {utf16,Endian}),
+ BrokenPart = iolist_to_binary(DeepBrokenPart),
+ utf16_inner_loop(List, BrokenPart, BrokenSz, PartlyBroken, PBSz, Endian);
+utf16_inner_loop([], _, _, _, _, _) ->
ok.
ex_binaries_errors_utf32_big(Config) when is_list(Config) ->
- BrokenPart = << <<X:32/big>> || X <- lists:seq(16#DC00,16#DFFF) >>,
- BrokenSz = byte_size(BrokenPart),
- [ begin
- OKList = lists:flatten(lists:duplicate(N,lists:seq(1,255))),
- OKBin = unicode:characters_to_binary(OKList,unicode,{utf32,big}),
- OKLen = length(OKList),
- %% Copy to avoid that the binary get's writable
- PartlyBroken = binary:copy(<<OKBin/binary, BrokenPart/binary>>),
- PBSz = byte_size(PartlyBroken),
- {error,OKList,DeepBrokenPart} =
- unicode:characters_to_list(PartlyBroken,{utf32,big}),
- BrokenPart = iolist_to_binary(DeepBrokenPart),
- [ begin
- NewList = lists:nthtail(X, OKList),
- NewSz = byte_size(unicode:characters_to_binary(NewList,unicode,{utf32,big})) +
- BrokenSz,
- Chomped = binary:part(PartlyBroken,PBSz - NewSz, NewSz),
- true = (binary:referenced_byte_size(Chomped) =:= PBSz),
- {error,NewList,DeepBrokenPart2} =
- unicode:characters_to_list(Chomped,{utf32,big}),
- BrokenPart = iolist_to_binary(DeepBrokenPart2)
- end || X <- lists:seq(1,OKLen) ]
- end || N <- lists:seq(1,16,3) ],
- ok.
+ ex_binaries_errors_utf32(big).
ex_binaries_errors_utf32_little(Config) when is_list(Config) ->
- BrokenPart = << <<X:32/little>> || X <- lists:seq(16#DC00,16#DFFF) >>,
+ ex_binaries_errors_utf32(little).
+
+ex_binaries_errors_utf32(Endian) ->
+ BrokenSeq = lists:seq(16#DC00, 16#DFFF),
+ BrokenPart = case Endian of
+ little ->
+ << <<X:32/little>> || X <- BrokenSeq >>;
+ big ->
+ << <<X:32/big>> || X <- BrokenSeq >>
+ end,
BrokenSz = byte_size(BrokenPart),
+ Seq255 = lists:seq(1, 255),
[ begin
- OKList = lists:flatten(lists:duplicate(N,lists:seq(1,255))),
- OKBin = unicode:characters_to_binary(OKList,unicode,{utf32,little}),
- OKLen = length(OKList),
- %% Copy to avoid that the binary get's writable
- PartlyBroken = binary:copy(<<OKBin/binary, BrokenPart/binary>>),
+ OKList = lists:append(lists:duplicate(N, Seq255)),
+ OKBin = unicode:characters_to_binary(OKList, unicode, {utf32,Endian}),
+ PartlyBroken = iolist_to_binary([OKBin,BrokenPart]),
PBSz = byte_size(PartlyBroken),
{error,OKList,DeepBrokenPart} =
- unicode:characters_to_list(PartlyBroken,{utf32,little}),
+ unicode:characters_to_list(PartlyBroken, {utf32,Endian}),
BrokenPart = iolist_to_binary(DeepBrokenPart),
- [ begin
- NewList = lists:nthtail(X, OKList),
- NewSz = byte_size(unicode:characters_to_binary(NewList,unicode,{utf32,little})) +
- BrokenSz,
- Chomped = binary:part(PartlyBroken,PBSz - NewSz, NewSz),
- true = (binary:referenced_byte_size(Chomped) =:= PBSz),
- {error,NewList,DeepBrokenPart2} =
- unicode:characters_to_list(Chomped,{utf32,little}),
- BrokenPart = iolist_to_binary(DeepBrokenPart2)
- end || X <- lists:seq(1,OKLen) ]
- end || N <- lists:seq(1,16,3) ],
+ utf32_inner_loop(OKList, BrokenPart, BrokenSz,
+ PartlyBroken, PBSz, Endian)
+ end || N <- lists:seq(1, 16, 3) ],
ok.
-
+utf32_inner_loop([_|List], BrokenPart, BrokenSz, PartlyBroken, PBSz, Endian) ->
+ Sz = length(List)*4 + BrokenSz,
+ Chomped = binary:part(PartlyBroken, PBSz - Sz, Sz),
+ true = binary:referenced_byte_size(Chomped) =:= PBSz,
+ {error,List,DeepBrokenPart} =
+ unicode:characters_to_list(Chomped, {utf32,Endian}),
+ BrokenPart = iolist_to_binary(DeepBrokenPart),
+ utf32_inner_loop(List, BrokenPart, BrokenSz, PartlyBroken, PBSz, Endian);
+utf32_inner_loop([], _, _, _, _, _) ->
+ ok.
exceptions(Config) when is_list(Config) ->
setlimit(10),
diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl
index d168a9d9bc..08243f7c4f 100644
--- a/lib/stdlib/test/zip_SUITE.erl
+++ b/lib/stdlib/test/zip_SUITE.erl
@@ -84,7 +84,7 @@ borderline_test(Size, TempDir) ->
io:format("Testing size ~p", [Size]),
%% Create a file and archive it.
- {_, _, X0} = erlang:now(),
+ {_, _, X0} = erlang:timestamp(),
file:write_file(Name, random_byte_list(X0, Size)),
{ok, Archive} = zip:zip(Archive, [Name]),
ok = file:delete(Name),
@@ -606,7 +606,7 @@ zip_to_binary(Config) when is_list(Config) ->
aliases(doc) ->
["Test using the aliases, extract/2, table/2 and create/3"];
aliases(Config) when is_list(Config) ->
- {_, _, X0} = erlang:now(),
+ {_, _, X0} = erlang:timestamp(),
Size = 100,
B = list_to_binary(random_byte_list(X0, Size)),
%% create