aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--erts/emulator/test/lcnt_SUITE.erl3
-rw-r--r--lib/common_test/src/test_server_node.erl103
-rw-r--r--lib/compiler/src/cerl.erl16
-rw-r--r--lib/compiler/src/core_parse.hrl107
-rw-r--r--lib/kernel/test/file_SUITE.erl39
-rw-r--r--lib/ssl/test/ssl_test_lib.erl183
-rw-r--r--lib/ssl/test/ssl_to_openssl_SUITE.erl52
-rw-r--r--lib/tools/emacs/erlang-test.el11
-rw-r--r--lib/tools/emacs/erlang.el560
-rw-r--r--lib/tools/test/emacs_SUITE.erl23
10 files changed, 695 insertions, 402 deletions
diff --git a/erts/emulator/test/lcnt_SUITE.erl b/erts/emulator/test/lcnt_SUITE.erl
index 87b97037d6..2dbaec9942 100644
--- a/erts/emulator/test/lcnt_SUITE.erl
+++ b/erts/emulator/test/lcnt_SUITE.erl
@@ -187,5 +187,8 @@ remove_untoggleable_locks([]) ->
[];
remove_untoggleable_locks([{resource_monitors, _, _, _} | T]) ->
remove_untoggleable_locks(T);
+remove_untoggleable_locks([{'socket[gcnt]', _, _, _} | T]) ->
+ %% Global lock used by socket NIF
+ remove_untoggleable_locks(T);
remove_untoggleable_locks([H | T]) ->
[H | remove_untoggleable_locks(T)].
diff --git a/lib/common_test/src/test_server_node.erl b/lib/common_test/src/test_server_node.erl
index ea7ad8538e..3ae4a047d8 100644
--- a/lib/common_test/src/test_server_node.erl
+++ b/lib/common_test/src/test_server_node.erl
@@ -656,9 +656,19 @@ find_release({unix,linux}, Rel) ->
find_release(_, _) -> none.
find_rel_linux(Rel) ->
- case suse_release() of
- none -> [];
- SuseRel -> find_rel_suse(Rel, SuseRel)
+ try
+ case ubuntu_release() of
+ none -> none;
+ [UbuntuRel |_] -> throw(find_rel_ubuntu(Rel, UbuntuRel))
+ end,
+ case suse_release() of
+ none -> none;
+ SuseRel -> throw(find_rel_suse(Rel, SuseRel))
+ end,
+ []
+ catch
+ throw:Result ->
+ Result
end.
find_rel_suse(Rel, SuseRel) ->
@@ -735,6 +745,93 @@ suse_release(Fd) ->
end
end.
+find_rel_ubuntu(_Rel, UbuntuRel) when is_integer(UbuntuRel), UbuntuRel < 16 ->
+ [];
+find_rel_ubuntu(Rel, UbuntuRel) when is_integer(UbuntuRel) ->
+ Root = "/usr/local/otp/releases/ubuntu",
+ lists:foldl(fun (ChkUbuntuRel, Acc) ->
+ find_rel_ubuntu_aux1(Rel, Root++integer_to_list(ChkUbuntuRel))
+ ++ Acc
+ end,
+ [],
+ lists:seq(16, UbuntuRel)).
+
+find_rel_ubuntu_aux1(Rel, RootWc) ->
+ case erlang:system_info(wordsize) of
+ 4 ->
+ find_rel_ubuntu_aux2(Rel, RootWc++"_32");
+ 8 ->
+ find_rel_ubuntu_aux2(Rel, RootWc++"_64") ++
+ find_rel_ubuntu_aux2(Rel, RootWc++"_32")
+ end.
+
+find_rel_ubuntu_aux2(Rel, RootWc) ->
+ RelDir = filename:dirname(RootWc),
+ Pat = filename:basename(RootWc ++ "_" ++ Rel) ++ ".*",
+ case file:list_dir(RelDir) of
+ {ok,Dirs} ->
+ case lists:filter(fun(Dir) ->
+ case re:run(Dir, Pat, [unicode]) of
+ nomatch -> false;
+ _ -> true
+ end
+ end, Dirs) of
+ [] ->
+ [];
+ [R|_] ->
+ [filename:join([RelDir,R,"bin","erl"])]
+ end;
+ _ ->
+ []
+ end.
+
+ubuntu_release() ->
+ case file:open("/etc/lsb-release", [read]) of
+ {ok,Fd} ->
+ try
+ ubuntu_release(Fd, undefined, undefined)
+ after
+ file:close(Fd)
+ end;
+ {error,_} -> none
+ end.
+
+ubuntu_release(_Fd, DistrId, Rel) when DistrId /= undefined,
+ Rel /= undefined ->
+ Ubuntu = case DistrId of
+ "Ubuntu" -> true;
+ "ubuntu" -> true;
+ _ -> false
+ end,
+ case Ubuntu of
+ false -> none;
+ true -> Rel
+ end;
+ubuntu_release(Fd, DistroId, Rel) ->
+ case io:get_line(Fd, '') of
+ eof ->
+ none;
+ Line when is_list(Line) ->
+ case re:run(Line, "^DISTRIB_ID=(\\w+)$",
+ [{capture,all_but_first,list}]) of
+ {match,[NewDistroId]} ->
+ ubuntu_release(Fd, NewDistroId, Rel);
+ nomatch ->
+ case re:run(Line, "^DISTRIB_RELEASE=(\\d+(?:\\.\\d+)*)$",
+ [{capture,all_but_first,list}]) of
+ {match,[RelList]} ->
+ NewRel = lists:map(fun (N) ->
+ list_to_integer(N)
+ end,
+ string:lexemes(RelList, ".")),
+ ubuntu_release(Fd, DistroId, NewRel);
+ nomatch ->
+ ubuntu_release(Fd, DistroId, Rel)
+ end
+ end
+ end.
+
+
unpack(Bin) ->
{One,Term} = split_binary(Bin, 1),
case binary_to_list(One) of
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index fce23bfd68..62cd5b5120 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -2157,12 +2157,16 @@ values_arity(Node) ->
%% @spec c_binary(Segments::[cerl()]) -> cerl()
%%
-%% @doc Creates an abstract binary-template. A binary object is a
-%% sequence of 8-bit bytes. It is specified by zero or more bit-string
-%% template <em>segments</em> of arbitrary lengths (in number of bits),
-%% such that the sum of the lengths is evenly divisible by 8. If
-%% <code>Segments</code> is <code>[S1, ..., Sn]</code>, the result
-%% represents "<code>#{<em>S1</em>, ..., <em>Sn</em>}#</code>". All the
+
+%% @doc Creates an abstract binary-template. A binary object is in
+%% this context a sequence of an arbitrary number of bits. (The number
+%% of bits used to be evenly divisible by 8, but after the
+%% introduction of bit strings in the Erlang language, the choice was
+%% made to use the binary template for all bit strings.) It is
+%% specified by zero or more bit-string template <em>segments</em> of
+%% arbitrary lengths (in number of bits). If <code>Segments</code> is
+%% <code>[S1, ..., Sn]</code>, the result represents
+%% "<code>#{<em>S1</em>, ..., <em>Sn</em>}#</code>". All the
%% <code>Si</code> must have type <code>bitstr</code>.
%%
%% @see ann_c_binary/2
diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl
index 83a6f0179c..90c796d3d9 100644
--- a/lib/compiler/src/core_parse.hrl
+++ b/lib/compiler/src/core_parse.hrl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2019. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -29,81 +29,82 @@
%% The record definitions appear alphabetically
--record(c_alias, {anno=[], var, % var :: Tree,
- pat}). % pat :: Tree
+-record(c_alias, {anno=[] :: list(), var :: cerl:cerl(),
+ pat :: cerl:cerl()}).
--record(c_apply, {anno=[], op, % op :: Tree,
- args}). % args :: [Tree]
+-record(c_apply, {anno=[] :: list(), op :: cerl:cerl(),
+ args :: [cerl:cerl()]}).
--record(c_binary, {anno=[], segments :: [cerl:c_bitstr()]}).
+-record(c_binary, {anno=[] :: list(), segments :: [cerl:c_bitstr()]}).
--record(c_bitstr, {anno=[], val, % val :: Tree,
- size, % size :: Tree,
- unit, % unit :: Tree,
- type, % type :: Tree,
- flags}). % flags :: Tree
+-record(c_bitstr, {anno=[] :: list(), val :: cerl:cerl(),
+ size :: cerl:cerl(),
+ unit :: cerl:cerl(),
+ type :: cerl:cerl(),
+ flags :: cerl:cerl()}).
--record(c_call, {anno=[], module, % module :: Tree,
- name, % name :: Tree,
- args}). % args :: [Tree]
+-record(c_call, {anno=[] :: list(), module :: cerl:cerl(),
+ name :: cerl:cerl(),
+ args :: [cerl:cerl()]}).
--record(c_case, {anno=[], arg, % arg :: Tree,
- clauses}). % clauses :: [Tree]
+-record(c_case, {anno=[] :: list(), arg :: cerl:cerl(),
+ clauses :: [cerl:cerl()]}).
--record(c_catch, {anno=[], body}). % body :: Tree
+-record(c_catch, {anno=[] :: list(), body :: cerl:cerl()}).
--record(c_clause, {anno=[], pats, % pats :: [Tree],
- guard, % guard :: Tree,
- body}). % body :: Tree
+-record(c_clause, {anno=[] :: list(), pats :: [cerl:cerl()],
+ guard :: cerl:cerl(),
+ body :: cerl:cerl() | any()}). % TODO
--record(c_cons, {anno=[], hd, % hd :: Tree,
- tl}). % tl :: Tree
+-record(c_cons, {anno=[] :: list(), hd :: cerl:cerl(),
+ tl :: cerl:cerl()}).
--record(c_fun, {anno=[], vars, % vars :: [Tree],
- body}). % body :: Tree
+-record(c_fun, {anno=[] :: list(), vars :: [cerl:cerl()],
+ body :: cerl:cerl()}).
--record(c_let, {anno=[], vars, % vars :: [Tree],
- arg, % arg :: Tree,
- body}). % body :: Tree
+-record(c_let, {anno=[] :: list(), vars :: [cerl:cerl()],
+ arg :: cerl:cerl(),
+ body :: cerl:cerl()}).
--record(c_letrec, {anno=[], defs, % defs :: [#c_def{}],
- body}). % body :: Tree
+-record(c_letrec, {anno=[] :: list(),
+ defs :: [{cerl:cerl(), cerl:cerl()}],
+ body :: cerl:cerl()}).
--record(c_literal, {anno=[], val}). % val :: literal()
+-record(c_literal, {anno=[] :: list(), val :: any()}).
--record(c_map, {anno=[],
+-record(c_map, {anno=[] :: list(),
arg=#c_literal{val=#{}} :: cerl:c_var() | cerl:c_literal(),
es :: [cerl:c_map_pair()],
is_pat=false :: boolean()}).
--record(c_map_pair, {anno=[],
+-record(c_map_pair, {anno=[] :: list(),
op :: #c_literal{val::'assoc'} | #c_literal{val::'exact'},
- key,
- val}).
+ key :: any(), % TODO
+ val :: any()}). % TODO
--record(c_module, {anno=[], name, % name :: Tree,
- exports, % exports :: [Tree],
- attrs, % attrs :: [#c_def{}],
- defs}). % defs :: [#c_def{}]
+-record(c_module, {anno=[] :: list(), name :: cerl:cerl(),
+ exports :: [cerl:cerl()],
+ attrs :: [{cerl:cerl(), cerl:cerl()}],
+ defs :: [{cerl:cerl(), cerl:cerl()}]}).
--record(c_primop, {anno=[], name, % name :: Tree,
- args}). % args :: [Tree]
+-record(c_primop, {anno=[] :: list(), name :: cerl:cerl(),
+ args :: [cerl:cerl()]}).
--record(c_receive, {anno=[], clauses, % clauses :: [Tree],
- timeout, % timeout :: Tree,
- action}). % action :: Tree
+-record(c_receive, {anno=[] :: list(), clauses :: [cerl:cerl()],
+ timeout :: cerl:cerl(),
+ action :: cerl:cerl()}).
--record(c_seq, {anno=[], arg, % arg :: Tree,
- body}). % body :: Tree
+-record(c_seq, {anno=[] :: list(), arg :: cerl:cerl() | any(), % TODO
+ body :: cerl:cerl()}).
--record(c_try, {anno=[], arg, % arg :: Tree,
- vars, % vars :: [Tree],
- body, % body :: Tree
- evars, % evars :: [Tree],
- handler}). % handler :: Tree
+-record(c_try, {anno=[] :: list(), arg :: cerl:cerl(),
+ vars :: [cerl:cerl()],
+ body :: cerl:cerl(),
+ evars :: [cerl:cerl()],
+ handler :: cerl:cerl()}).
--record(c_tuple, {anno=[], es}). % es :: [Tree]
+-record(c_tuple, {anno=[] :: list(), es :: [cerl:cerl()]}).
--record(c_values, {anno=[], es}). % es :: [Tree]
+-record(c_values, {anno=[] :: list(), es :: [cerl:cerl()]}).
--record(c_var, {anno=[], name :: cerl:var_name()}).
+-record(c_var, {anno=[] :: list(), name :: cerl:var_name()}).
diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl
index e095e589a3..3bc8e6e828 100644
--- a/lib/kernel/test/file_SUITE.erl
+++ b/lib/kernel/test/file_SUITE.erl
@@ -4514,15 +4514,18 @@ run_large_file_test(Config, Run, Name) ->
{{unix,sunos},OsVersion} when OsVersion < {5,5,1} ->
{skip,"Only supported on Win32, Unix or SunOS >= 5.5.1"};
{{unix,_},_} ->
- N = disc_free(proplists:get_value(priv_dir, Config)),
- io:format("Free disk: ~w KByte~n", [N]),
- if N < 5 * (1 bsl 20) ->
- %% Less than 5 GByte free
- {skip,"Less than 5 GByte free"};
- true ->
- do_run_large_file_test(Config, Run, Name)
- end;
- _ ->
+ case disc_free(proplists:get_value(priv_dir, Config)) of
+ error ->
+ {skip, "Failed to query disk space for priv_dir. "
+ "Is it on a remote file system?~n"};
+ N when N >= 5 * (1 bsl 20) ->
+ ct:pal("Free disk: ~w KByte~n", [N]),
+ do_run_large_file_test(Config, Run, Name);
+ N when N < 5 * (1 bsl 20) ->
+ ct:pal("Free disk: ~w KByte~n", [N]),
+ {skip,"Less than 5 GByte free"}
+ end;
+ _ ->
{skip,"Only supported on Win32, Unix or SunOS >= 5.5.1"}
end.
@@ -4556,12 +4559,18 @@ do_run_large_file_test(Config, Run, Name0) ->
disc_free(Path) ->
Data = disksup:get_disk_data(),
- {_,Tot,Perc} = hd(lists:filter(
- fun({P,_Size,_Full}) ->
- lists:prefix(filename:nativename(P),
- filename:nativename(Path))
- end, lists:reverse(lists:sort(Data)))),
- round(Tot * (1-(Perc/100))).
+
+ %% What partitions could Data be mounted on?
+ Partitions =
+ [D || {P, _Tot, _Perc}=D <- Data,
+ lists:prefix(filename:nativename(P), filename:nativename(Path))],
+
+ %% Sorting in descending order places the partition with the most specific
+ %% path first.
+ case lists:sort(fun erlang:'>='/2, Partitions) of
+ [{_,Tot, Perc} | _] -> round(Tot * (1-(Perc/100)));
+ [] -> error
+ end.
memsize() ->
{Tot,_Used,_} = memsup:get_memory_data(),
diff --git a/lib/ssl/test/ssl_test_lib.erl b/lib/ssl/test/ssl_test_lib.erl
index 22169035f3..94c2cb8d9b 100644
--- a/lib/ssl/test/ssl_test_lib.erl
+++ b/lib/ssl/test/ssl_test_lib.erl
@@ -51,20 +51,20 @@ node_to_hostip(Node) ->
Address.
start_server(Args) ->
- Result = spawn_link(?MODULE, run_server, [Args]),
+ Node = proplists:get_value(node, Args),
+ Result = spawn_link(Node, ?MODULE, run_server, [Args]),
receive
{listen, up} ->
Result
end.
run_server(Opts) ->
- Node = proplists:get_value(node, Opts),
Port = proplists:get_value(port, Opts),
Options = proplists:get_value(options, Opts),
Pid = proplists:get_value(from, Opts),
Transport = proplists:get_value(transport, Opts, ssl),
ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]),
- {ok, ListenSocket} = rpc:call(Node, Transport, listen, [Port, Options]),
+ {ok, ListenSocket} = Transport:listen(Port, Options),
Pid ! {listen, up},
send_selected_port(Pid, Port, ListenSocket),
run_server(ListenSocket, Opts).
@@ -90,13 +90,12 @@ do_run_server(_, ok = Result, Opts) ->
Pid = proplists:get_value(from, Opts),
Pid ! {self(), Result};
do_run_server(ListenSocket, AcceptSocket, Opts) ->
- Node = proplists:get_value(node, Opts),
Pid = proplists:get_value(from, Opts),
Transport = proplists:get_value(transport, Opts, ssl),
{Module, Function, Args} = proplists:get_value(mfa, Opts),
ct:log("~p:~p~nServer: apply(~p,~p,~p)~n",
[?MODULE,?LINE, Module, Function, [AcceptSocket | Args]]),
- case rpc:call(Node, Module, Function, [AcceptSocket | Args]) of
+ case apply(Module, Function, [AcceptSocket | Args]) of
no_result_msg ->
ok;
Msg ->
@@ -110,8 +109,8 @@ do_run_server(ListenSocket, AcceptSocket, Opts) ->
run_server(ListenSocket, [MFA | proplists:delete(mfa, Opts)]);
close ->
ct:log("~p:~p~nServer closing ~p ~n", [?MODULE,?LINE, self()]),
- Result = rpc:call(Node, Transport, close, [AcceptSocket], 500),
- Result1 = rpc:call(Node, Transport, close, [ListenSocket], 500),
+ Result = Transport:close(AcceptSocket),
+ Result1 = Transport:close(ListenSocket),
ct:log("~p:~p~nResult ~p : ~p ~n", [?MODULE,?LINE, Result, Result1]);
{ssl_closed, _} ->
ok
@@ -132,41 +131,37 @@ connect(#sslsocket{} = ListenSocket, Opts) ->
remove_close_msg(ReconnectTimes),
AcceptSocket
end;
-connect(ListenSocket, Opts) ->
- Node = proplists:get_value(node, Opts),
+connect(ListenSocket, _Opts) ->
ct:log("~p:~p~ngen_tcp:accept(~p)~n", [?MODULE,?LINE, ListenSocket]),
- {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept,
- [ListenSocket]),
+ {ok, AcceptSocket} = gen_tcp:accept(ListenSocket),
AcceptSocket.
connect(_, _, 0, AcceptSocket, _, _, _) ->
AcceptSocket;
connect(ListenSocket, Node, _N, _, Timeout, SslOpts, cancel) ->
ct:log("ssl:transport_accept(~p)~n", [ListenSocket]),
- {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept,
- [ListenSocket]),
+ {ok, AcceptSocket} = ssl:transport_accept(ListenSocket),
ct:log("~p:~p~nssl:handshake(~p,~p,~p)~n", [?MODULE,?LINE, AcceptSocket, SslOpts,Timeout]),
- case rpc:call(Node, ssl, handshake, [AcceptSocket, SslOpts, Timeout]) of
+ case ssl:handshake(AcceptSocket, SslOpts, Timeout) of
{ok, Socket0, Ext} ->
ct:log("Ext ~p:~n", [Ext]),
ct:log("~p:~p~nssl:handshake_cancel(~p)~n", [?MODULE,?LINE, Socket0]),
- rpc:call(Node, ssl, handshake_cancel, [Socket0]);
+ ssl:handshake_cancel(Socket0);
Result ->
ct:log("~p:~p~nssl:handshake@~p ret ~p",[?MODULE,?LINE, Node,Result]),
Result
end;
connect(ListenSocket, Node, N, _, Timeout, SslOpts, [_|_] =ContOpts) ->
ct:log("ssl:transport_accept(~p)~n", [ListenSocket]),
- {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept,
- [ListenSocket]),
+ {ok, AcceptSocket} = ssl:transport_accept(ListenSocket),
ct:log("~p:~p~nssl:handshake(~p,~p,~p)~n", [?MODULE,?LINE, AcceptSocket, SslOpts,Timeout]),
- case rpc:call(Node, ssl, handshake, [AcceptSocket, SslOpts, Timeout]) of
+ case ssl:handshake(AcceptSocket, SslOpts, Timeout) of
{ok, Socket0, Ext} ->
ct:log("Ext ~p:~n", [Ext]),
ct:log("~p:~p~nssl:handshake_continue(~p,~p,~p)~n", [?MODULE,?LINE, Socket0, ContOpts,Timeout]),
- case rpc:call(Node, ssl, handshake_continue, [Socket0, ContOpts, Timeout]) of
+ case ssl:handshake_continue(Socket0, ContOpts, Timeout) of
{ok, Socket} ->
connect(ListenSocket, Node, N-1, Socket, Timeout, SslOpts, ContOpts);
Error ->
@@ -179,35 +174,35 @@ connect(ListenSocket, Node, N, _, Timeout, SslOpts, [_|_] =ContOpts) ->
end;
connect(ListenSocket, Node, N, _, Timeout, [], ContOpts) ->
ct:log("ssl:transport_accept(~p)~n", [ListenSocket]),
- {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept,
- [ListenSocket]),
+ {ok, AcceptSocket} = ssl:transport_accept(ListenSocket),
ct:log("~p:~p~nssl:ssl_accept(~p, ~p)~n", [?MODULE,?LINE, AcceptSocket, Timeout]),
- case rpc:call(Node, ssl, ssl_accept, [AcceptSocket, Timeout]) of
- ok ->
- connect(ListenSocket, Node, N-1, AcceptSocket, Timeout, [], ContOpts);
+ case ssl:handshake(AcceptSocket, Timeout) of
+ {ok, Socket} ->
+ connect(ListenSocket, Node, N-1, Socket, Timeout, [], ContOpts);
Result ->
- ct:log("~p:~p~nssl:ssl_accept@~p ret ~p",[?MODULE,?LINE, Node,Result]),
+ ct:log("~p:~p~nssl:handshake@~p ret ~p",[?MODULE,?LINE, Node,Result]),
Result
end;
-connect(ListenSocket, Node, _, _, Timeout, Opts, _) ->
+connect(ListenSocket, _Node, _, _, Timeout, Opts, _) ->
ct:log("ssl:transport_accept(~p)~n", [ListenSocket]),
- {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept,
- [ListenSocket]),
- ct:log("ssl:ssl_accept(~p,~p, ~p)~n", [AcceptSocket, Opts, Timeout]),
- rpc:call(Node, ssl, ssl_accept, [AcceptSocket, Opts, Timeout]),
+ {ok, AcceptSocket} = ssl:transport_accept(ListenSocket),
+ ct:log("ssl:handshake(~p,~p, ~p)~n", [AcceptSocket, Opts, Timeout]),
+ ssl:handshake(AcceptSocket, Opts, Timeout),
AcceptSocket.
start_server_transport_abuse_socket(Args) ->
- Result = spawn_link(?MODULE, transport_accept_abuse, [Args]),
+ Node = proplists:get_value(node, Args),
+ Result = spawn_link(Node, ?MODULE, transport_accept_abuse, [Args]),
receive
{listen, up} ->
Result
end.
start_server_transport_control(Args) ->
- Result = spawn_link(?MODULE, transport_switch_control, [Args]),
+ Node = proplists:get_value(node, Args),
+ Result = spawn_link(Node, ?MODULE, transport_switch_control, [Args]),
receive
{listen, up} ->
Result
@@ -215,35 +210,31 @@ start_server_transport_control(Args) ->
transport_accept_abuse(Opts) ->
- Node = proplists:get_value(node, Opts),
Port = proplists:get_value(port, Opts),
Options = proplists:get_value(options, Opts),
Pid = proplists:get_value(from, Opts),
Transport = proplists:get_value(transport, Opts, ssl),
ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]),
- {ok, ListenSocket} = rpc:call(Node, Transport, listen, [Port, Options]),
+ {ok, ListenSocket} = Transport:listen(Port, Options),
Pid ! {listen, up},
send_selected_port(Pid, Port, ListenSocket),
- {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept,
- [ListenSocket]),
- {error, _} = rpc:call(Node, ssl, connection_information, [AcceptSocket]),
- _ = rpc:call(Node, ssl, handshake, [AcceptSocket, infinity]),
+ {ok, AcceptSocket} = ssl:transport_accept(ListenSocket),
+ {error, _} = ssl:connection_information(AcceptSocket),
+ _ = ssl:handshake(AcceptSocket, infinity),
Pid ! {self(), ok}.
transport_switch_control(Opts) ->
- Node = proplists:get_value(node, Opts),
Port = proplists:get_value(port, Opts),
Options = proplists:get_value(options, Opts),
Pid = proplists:get_value(from, Opts),
Transport = proplists:get_value(transport, Opts, ssl),
ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]),
- {ok, ListenSocket} = rpc:call(Node, Transport, listen, [Port, Options]),
+ {ok, ListenSocket} = Transport:listen(Port, Options),
Pid ! {listen, up},
send_selected_port(Pid, Port, ListenSocket),
- {ok, AcceptSocket} = rpc:call(Node, ssl, transport_accept,
- [ListenSocket]),
- ok = rpc:call(Node, ssl, controlling_process, [AcceptSocket, self()]),
+ {ok, AcceptSocket} = ssl:transport_accept(ListenSocket),
+ ok = ssl:controlling_process(AcceptSocket, self()),
Pid ! {self(), ok}.
@@ -256,7 +247,8 @@ remove_close_msg(ReconnectTimes) ->
end.
start_client(Args) ->
- Result = spawn_link(?MODULE, run_client_init, [lists:delete(return_socket, Args)]),
+ Node = proplists:get_value(node, Args),
+ Result = spawn_link(Node, ?MODULE, run_client_init, [lists:delete(return_socket, Args)]),
receive
{connected, Socket} ->
case lists:member(return_socket, Args) of
@@ -288,8 +280,8 @@ run_client(Opts) ->
client_cont_loop(Node, Host, Port, Pid, Transport, Options, ContOpts, Opts)
end.
-client_loop(Node, Host, Port, Pid, Transport, Options, Opts) ->
- case rpc:call(Node, Transport, connect, [Host, Port, Options]) of
+client_loop(_Node, Host, Port, Pid, Transport, Options, Opts) ->
+ case Transport:connect(Host, Port, Options) of
{ok, Socket} ->
Pid ! {connected, Socket},
ct:log("~p:~p~nClient: connected~n", [?MODULE,?LINE]),
@@ -299,7 +291,7 @@ client_loop(Node, Host, Port, Pid, Transport, Options, Opts) ->
{Module, Function, Args} = proplists:get_value(mfa, Opts),
ct:log("~p:~p~nClient: apply(~p,~p,~p)~n",
[?MODULE,?LINE, Module, Function, [Socket | Args]]),
- case rpc:call(Node, Module, Function, [Socket | Args]) of
+ case apply(Module, Function, [Socket | Args]) of
no_result_msg ->
ok;
Msg ->
@@ -309,7 +301,7 @@ client_loop(Node, Host, Port, Pid, Transport, Options, Opts) ->
receive
close ->
ct:log("~p:~p~nClient closing~n", [?MODULE,?LINE]),
- rpc:call(Node, Transport, close, [Socket]);
+ Transport:close(Socket);
{ssl_closed, Socket} ->
ok;
{gen_tcp, closed} ->
@@ -339,16 +331,13 @@ client_loop(Node, Host, Port, Pid, Transport, Options, Opts) ->
end;
{error, Reason} ->
ct:log("~p:~p~nClient: connection failed: ~p ~n", [?MODULE,?LINE, Reason]),
- Pid ! {connect_failed, Reason};
- {badrpc,BadRPC} ->
- ct:log("~p:~p~nBad rpc: ~p",[?MODULE,?LINE, BadRPC]),
- Pid ! {connect_failed, {badrpc,BadRPC}}
+ Pid ! {connect_failed, Reason}
end.
-client_cont_loop(Node, Host, Port, Pid, Transport, Options, cancel, _Opts) ->
- case rpc:call(Node, Transport, connect, [Host, Port, Options]) of
+client_cont_loop(_Node, Host, Port, Pid, Transport, Options, cancel, _Opts) ->
+ case Transport:connect(Host, Port, Options) of
{ok, Socket, _} ->
- Result = rpc:call(Node, Transport, handshake_cancel, [Socket]),
+ Result = Transport:handshake_cancel(Socket),
ct:log("~p:~p~nClient: Cancel: ~p ~n", [?MODULE,?LINE, Result]),
Pid ! {connect_failed, Result};
{error, Reason} ->
@@ -356,17 +345,17 @@ client_cont_loop(Node, Host, Port, Pid, Transport, Options, cancel, _Opts) ->
Pid ! {connect_failed, Reason}
end;
-client_cont_loop(Node, Host, Port, Pid, Transport, Options, ContOpts, Opts) ->
- case rpc:call(Node, Transport, connect, [Host, Port, Options]) of
+client_cont_loop(_Node, Host, Port, Pid, Transport, Options, ContOpts, Opts) ->
+ case Transport:connect(Host, Port, Options) of
{ok, Socket0, _} ->
ct:log("~p:~p~nClient: handshake_continue(~p, ~p, infinity) ~n", [?MODULE, ?LINE, Socket0, ContOpts]),
- case rpc:call(Node, Transport, handshake_continue, [Socket0, ContOpts]) of
+ case Transport:handshake_continue(Socket0, ContOpts) of
{ok, Socket} ->
Pid ! {connected, Socket},
{Module, Function, Args} = proplists:get_value(mfa, Opts),
ct:log("~p:~p~nClient: apply(~p,~p,~p)~n",
[?MODULE,?LINE, Module, Function, [Socket | Args]]),
- case rpc:call(Node, Module, Function, [Socket | Args]) of
+ case apply(Module, Function, [Socket | Args]) of
no_result_msg ->
ok;
Msg ->
@@ -896,14 +885,14 @@ make_ecdh_rsa_cert(Config) ->
end.
start_upgrade_server(Args) ->
- Result = spawn_link(?MODULE, run_upgrade_server, [Args]),
+ Node = proplists:get_value(node, Args),
+ Result = spawn_link(Node, ?MODULE, run_upgrade_server, [Args]),
receive
{listen, up} ->
Result
end.
run_upgrade_server(Opts) ->
- Node = proplists:get_value(node, Opts),
Port = proplists:get_value(port, Opts),
TimeOut = proplists:get_value(timeout, Opts, infinity),
TcpOptions = proplists:get_value(tcp_options, Opts),
@@ -911,43 +900,41 @@ run_upgrade_server(Opts) ->
Pid = proplists:get_value(from, Opts),
ct:log("~p:~p~ngen_tcp:listen(~p, ~p)~n", [?MODULE,?LINE, Port, TcpOptions]),
- {ok, ListenSocket} = rpc:call(Node, gen_tcp, listen, [Port, TcpOptions]),
+ {ok, ListenSocket} = gen_tcp:listen(Port, TcpOptions),
Pid ! {listen, up},
send_selected_port(Pid, Port, ListenSocket),
ct:log("~p:~p~ngen_tcp:accept(~p)~n", [?MODULE,?LINE, ListenSocket]),
- {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]),
+ {ok, AcceptSocket} = gen_tcp:accept(ListenSocket),
try
{ok, SslAcceptSocket} = case TimeOut of
infinity ->
- ct:log("~p:~p~nssl:ssl_accept(~p, ~p)~n",
+ ct:log("~p:~p~nssl:handshake(~p, ~p)~n",
[?MODULE,?LINE, AcceptSocket, SslOptions]),
- rpc:call(Node, ssl, ssl_accept,
- [AcceptSocket, SslOptions]);
+ ssl:handshake(AcceptSocket, SslOptions);
_ ->
- ct:log("~p:~p~nssl:ssl_accept(~p, ~p, ~p)~n",
+ ct:log("~p:~p~nssl:handshake(~p, ~p, ~p)~n",
[?MODULE,?LINE, AcceptSocket, SslOptions, TimeOut]),
- rpc:call(Node, ssl, ssl_accept,
- [AcceptSocket, SslOptions, TimeOut])
+ ssl:handshake(AcceptSocket, SslOptions, TimeOut)
end,
{Module, Function, Args} = proplists:get_value(mfa, Opts),
- Msg = rpc:call(Node, Module, Function, [SslAcceptSocket | Args]),
+ Msg = apply(Module, Function, [SslAcceptSocket | Args]),
ct:log("~p:~p~nUpgrade Server Msg: ~p ~n", [?MODULE,?LINE, Msg]),
Pid ! {self(), Msg},
receive
close ->
ct:log("~p:~p~nUpgrade Server closing~n", [?MODULE,?LINE]),
- rpc:call(Node, ssl, close, [SslAcceptSocket])
+ ssl:close(SslAcceptSocket)
end
catch error:{badmatch, Error} ->
Pid ! {self(), Error}
end.
start_upgrade_client(Args) ->
- spawn_link(?MODULE, run_upgrade_client, [Args]).
+ Node = proplists:get_value(node, Args),
+ spawn_link(Node, ?MODULE, run_upgrade_client, [Args]).
run_upgrade_client(Opts) ->
- Node = proplists:get_value(node, Opts),
Host = proplists:get_value(host, Opts),
Port = proplists:get_value(port, Opts),
Pid = proplists:get_value(from, Opts),
@@ -956,34 +943,34 @@ run_upgrade_client(Opts) ->
ct:log("~p:~p~ngen_tcp:connect(~p, ~p, ~p)~n",
[?MODULE,?LINE, Host, Port, TcpOptions]),
- {ok, Socket} = rpc:call(Node, gen_tcp, connect, [Host, Port, TcpOptions]),
+ {ok, Socket} = gen_tcp:connect(Host, Port, TcpOptions),
send_selected_port(Pid, Port, Socket),
ct:log("~p:~p~nssl:connect(~p, ~p)~n", [?MODULE,?LINE, Socket, SslOptions]),
- {ok, SslSocket} = rpc:call(Node, ssl, connect, [Socket, SslOptions]),
+ {ok, SslSocket} = ssl:connect(Socket, SslOptions),
{Module, Function, Args} = proplists:get_value(mfa, Opts),
ct:log("~p:~p~napply(~p, ~p, ~p)~n",
[?MODULE,?LINE, Module, Function, [SslSocket | Args]]),
- Msg = rpc:call(Node, Module, Function, [SslSocket | Args]),
+ Msg = apply(Module, Function, [SslSocket | Args]),
ct:log("~p:~p~nUpgrade Client Msg: ~p ~n", [?MODULE,?LINE, Msg]),
Pid ! {self(), Msg},
receive
close ->
ct:log("~p:~p~nUpgrade Client closing~n", [?MODULE,?LINE]),
- rpc:call(Node, ssl, close, [SslSocket])
+ ssl:close(SslSocket)
end.
start_upgrade_server_error(Args) ->
- Result = spawn_link(?MODULE, run_upgrade_server_error, [Args]),
+ Node = proplists:get_value(node, Args),
+ Result = spawn_link(Node,?MODULE, run_upgrade_server_error, [Args]),
receive
{listen, up} ->
Result
end.
run_upgrade_server_error(Opts) ->
- Node = proplists:get_value(node, Opts),
Port = proplists:get_value(port, Opts),
TimeOut = proplists:get_value(timeout, Opts, infinity),
TcpOptions = proplists:get_value(tcp_options, Opts),
@@ -991,22 +978,20 @@ run_upgrade_server_error(Opts) ->
Pid = proplists:get_value(from, Opts),
ct:log("~p:~p~ngen_tcp:listen(~p, ~p)~n", [?MODULE,?LINE, Port, TcpOptions]),
- {ok, ListenSocket} = rpc:call(Node, gen_tcp, listen, [Port, TcpOptions]),
+ {ok, ListenSocket} = gen_tcp:listen(Port, TcpOptions),
Pid ! {listen, up},
send_selected_port(Pid, Port, ListenSocket),
ct:log("~p:~p~ngen_tcp:accept(~p)~n", [?MODULE,?LINE, ListenSocket]),
- {ok, AcceptSocket} = rpc:call(Node, gen_tcp, accept, [ListenSocket]),
+ {ok, AcceptSocket} = gen_tcp:accept(ListenSocket),
Error = case TimeOut of
infinity ->
- ct:log("~p:~p~nssl:ssl_accept(~p, ~p)~n",
+ ct:log("~p:~p~nssl:handshake(~p, ~p)~n",
[?MODULE,?LINE, AcceptSocket, SslOptions]),
- rpc:call(Node, ssl, ssl_accept,
- [AcceptSocket, SslOptions]);
+ ssl:handshake(AcceptSocket, SslOptions);
_ ->
- ct:log("~p:~p~nssl:ssl_accept(~p, ~p, ~p)~n",
+ ct:log("~p:~p~nssl:ssl_handshake(~p, ~p, ~p)~n",
[?MODULE,?LINE, AcceptSocket, SslOptions, TimeOut]),
- rpc:call(Node, ssl, ssl_accept,
- [AcceptSocket, SslOptions, TimeOut])
+ ssl:handshake(AcceptSocket, SslOptions, TimeOut)
end,
Pid ! {self(), Error}.
@@ -1018,32 +1003,31 @@ start_server_error(Args) ->
end.
run_server_error(Opts) ->
- Node = proplists:get_value(node, Opts),
Port = proplists:get_value(port, Opts),
Options = proplists:get_value(options, Opts),
Pid = proplists:get_value(from, Opts),
Transport = proplists:get_value(transport, Opts, ssl),
ct:log("~p:~p~nssl:listen(~p, ~p)~n", [?MODULE,?LINE, Port, Options]),
- case rpc:call(Node, Transport, listen, [Port, Options]) of
+ case Transport:listen(Port, Options) of
{ok, #sslsocket{} = ListenSocket} ->
%% To make sure error_client will
%% get {error, closed} and not {error, connection_refused}
Pid ! {listen, up},
send_selected_port(Pid, Port, ListenSocket),
ct:log("~p:~p~nssl:transport_accept(~p)~n", [?MODULE,?LINE, ListenSocket]),
- case rpc:call(Node, Transport, transport_accept, [ListenSocket]) of
+ case Transport:transport_accept(ListenSocket) of
{error, _} = Error ->
Pid ! {self(), Error};
{ok, AcceptSocket} ->
ct:log("~p:~p~nssl:ssl_accept(~p)~n", [?MODULE,?LINE, AcceptSocket]),
- Error = rpc:call(Node, ssl, ssl_accept, [AcceptSocket]),
+ Error = ssl:handshake(AcceptSocket),
Pid ! {self(), Error}
end;
{ok, ListenSocket} ->
Pid ! {listen, up},
send_selected_port(Pid, Port, ListenSocket),
ct:log("~p:~p~n~p:accept(~p)~n", [?MODULE,?LINE, Transport, ListenSocket]),
- case rpc:call(Node, Transport, accept, [ListenSocket]) of
+ case Transport:accept(ListenSocket) of
{error, _} = Error ->
Pid ! {self(), Error}
end;
@@ -1055,17 +1039,17 @@ run_server_error(Opts) ->
end.
start_client_error(Args) ->
- spawn_link(?MODULE, run_client_error, [Args]).
+ Node = proplists:get_value(node, Args),
+ spawn_link(Node, ?MODULE, run_client_error, [Args]).
run_client_error(Opts) ->
- Node = proplists:get_value(node, Opts),
Host = proplists:get_value(host, Opts),
Port = proplists:get_value(port, Opts),
Pid = proplists:get_value(from, Opts),
Transport = proplists:get_value(transport, Opts, ssl),
Options = proplists:get_value(options, Opts),
ct:log("~p:~p~nssl:connect(~p, ~p, ~p)~n", [?MODULE,?LINE, Host, Port, Options]),
- Error = rpc:call(Node, Transport, connect, [Host, Port, Options]),
+ Error = Transport:connect(Host, Port, Options),
Pid ! {self(), Error}.
accepters(N) ->
@@ -1772,6 +1756,15 @@ is_sane_ecc(crypto) ->
is_sane_ecc(_) ->
sufficient_crypto_support(cipher_ec).
+is_sane_oppenssl_sni() ->
+ [{_,_, Bin}] = crypto:info_lib(),
+ case binary_to_list(Bin) of
+ "OpenSSL 0.9" ++ _ -> % Does not support ECC
+ false;
+ _ ->
+ true
+ end.
+
is_fips(openssl) ->
VersionStr = os:cmd("openssl version"),
case re:split(VersionStr, "fips") of
diff --git a/lib/ssl/test/ssl_to_openssl_SUITE.erl b/lib/ssl/test/ssl_to_openssl_SUITE.erl
index f22eb4ecdf..1a9a5b712d 100644
--- a/lib/ssl/test/ssl_to_openssl_SUITE.erl
+++ b/lib/ssl/test/ssl_to_openssl_SUITE.erl
@@ -1161,7 +1161,7 @@ ssl2_erlang_server_openssl_client(Config) when is_list(Config) ->
ct:log("Ports ~p~n", [[erlang:port_info(P) || P <- erlang:ports()]]),
ssl_test_lib:consume_port_exit(OpenSslPort),
- ssl_test_lib:check_server_alert(Server, bad_record_mac),
+ ssl_test_lib:check_server_alert(Server, unexpected_message),
process_flag(trap_exit, false).
%%--------------------------------------------------------------------
@@ -1462,6 +1462,7 @@ send_and_hostname(SSLSocket) ->
end.
erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) ->
+ Version = ssl_test_lib:protocol_version(Config),
ct:log("Start running handshake, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]),
ServerOptions = proplists:get_value(sni_server_opts, Config) ++ proplists:get_value(server_rsa_opts, Config),
{_, ServerNode, Hostname} = ssl_test_lib:run_where(Config),
@@ -1472,9 +1473,9 @@ erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname,
Exe = "openssl",
ClientArgs = case SNIHostname of
undefined ->
- openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname,Port);
+ openssl_client_args(Version, Hostname,Port);
_ ->
- openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname, Port, SNIHostname)
+ openssl_client_args(Version, Hostname, Port, SNIHostname)
end,
ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs),
@@ -1485,6 +1486,7 @@ erlang_server_openssl_client_sni_test(Config, SNIHostname, ExpectedSNIHostname,
erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHostname, ExpectedCN) ->
+ Version = ssl_test_lib:protocol_version(Config),
ct:log("Start running handshake for sni_fun, Config: ~p, SNIHostname: ~p, ExpectedSNIHostname: ~p, ExpectedCN: ~p", [Config, SNIHostname, ExpectedSNIHostname, ExpectedCN]),
[{sni_hosts, ServerSNIConf}] = proplists:get_value(sni_server_opts, Config),
SNIFun = fun(Domain) -> proplists:get_value(Domain, ServerSNIConf, undefined) end,
@@ -1497,9 +1499,9 @@ erlang_server_openssl_client_sni_test_sni_fun(Config, SNIHostname, ExpectedSNIHo
Exe = "openssl",
ClientArgs = case SNIHostname of
undefined ->
- openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname,Port);
+ openssl_client_args(Version, Hostname,Port);
_ ->
- openssl_client_args(ssl_test_lib:supports_ssl_tls_version(sslv2), Hostname, Port, SNIHostname)
+ openssl_client_args(Version, Hostname, Port, SNIHostname)
end,
ClientPort = ssl_test_lib:portable_open_port(Exe, ClientArgs),
@@ -1910,13 +1912,19 @@ send_wait_send(Socket, [ErlData, OpenSslData]) ->
check_openssl_sni_support(Config) ->
HelpText = os:cmd("openssl s_client --help"),
- case string:str(HelpText, "-servername") of
- 0 ->
- {skip, "Current openssl doesn't support SNI"};
- _ ->
- Config
+ case ssl_test_lib:is_sane_oppenssl_sni() of
+ true ->
+ case string:str(HelpText, "-servername") of
+ 0 ->
+ {skip, "Current openssl doesn't support SNI"};
+ _ ->
+ Config
+ end;
+ false ->
+ {skip, "Current openssl doesn't support SNI or extension handling is flawed"}
end.
+
check_openssl_npn_support(Config) ->
HelpText = os:cmd("openssl s_client --help"),
case string:str(HelpText, "nextprotoneg") of
@@ -1982,17 +1990,13 @@ workaround_openssl_s_clinent() ->
[]
end.
-openssl_client_args(false, Hostname, Port) ->
- ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port)];
-openssl_client_args(true, Hostname, Port) ->
- ["s_client", "-no_ssl2", "-connect", Hostname ++ ":" ++ integer_to_list(Port)].
+openssl_client_args(Version, Hostname, Port) ->
+ ["s_client", "-connect", Hostname ++ ":" ++ integer_to_list(Port), ssl_test_lib:version_flag(Version)].
-openssl_client_args(false, Hostname, Port, ServerName) ->
+openssl_client_args(Version, Hostname, Port, ServerName) ->
["s_client", "-connect", Hostname ++ ":" ++
- integer_to_list(Port), "-servername", ServerName];
-openssl_client_args(true, Hostname, Port, ServerName) ->
- ["s_client", "-no_ssl2", "-connect", Hostname ++ ":" ++
- integer_to_list(Port), "-servername", ServerName].
+ integer_to_list(Port), ssl_test_lib:version_flag(Version), "-servername", ServerName].
+
hostname_format(Hostname) ->
case lists:member($., Hostname) of
@@ -2002,16 +2006,6 @@ hostname_format(Hostname) ->
"localhost"
end.
-no_low_flag("-no_ssl2" = Flag) ->
- case ssl_test_lib:supports_ssl_tls_version(sslv2) of
- true ->
- Flag;
- false ->
- ""
- end;
-no_low_flag(Flag) ->
- Flag.
-
openssl_has_common_ciphers(Ciphers) ->
OCiphers = ssl_test_lib:common_ciphers(openssl),
diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el
index 2ee584d11a..fbdd298da3 100644
--- a/lib/tools/emacs/erlang-test.el
+++ b/lib/tools/emacs/erlang-test.el
@@ -50,8 +50,15 @@
;; The -L option adds a directory to the load-path. It should be the
;; directory containing erlang.el and erlang-test.el.
;;
-;; 3. Call the script test-erlang-mode in this directory. This script
-;; use the second method.
+;; 3. Run the emacs_SUITE. The testcases tests_interpreted/1 and
+;; tests_compiled/1 in this suite are using the second method. One
+;; way to run this suite is with the ct_run tool, for example like the
+;; following when standing at the OTP repo top directory:
+;;
+;; ct_run -suite lib/tools/test/emacs_SUITE
+;;
+;; Note that this creates a lot of html log files in the current
+;; directory.
;;; Code:
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index 38c0eba92b..0b3a2319e2 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -4,7 +4,7 @@
;; Author: Anders Lindgren
;; Keywords: erlang, languages, processes
;; Date: 2011-12-11
-;; Version: 2.8.1
+;; Version: 2.8.2
;; Package-Requires: ((emacs "24.1"))
;; %CopyrightBegin%
@@ -87,7 +87,7 @@
"The Erlang programming language."
:group 'languages)
-(defconst erlang-version "2.8.1"
+(defconst erlang-version "2.8.2"
"The version number of Erlang mode.")
(defcustom erlang-root-dir nil
@@ -502,6 +502,13 @@ regardless of where in the line point is when the TAB command is used."
:type 'boolean
:safe 'booleanp)
+(defcustom erlang-max-files-to-visit-for-refining-xrefs 32
+ "Upper limit how many files to visit for checking arity.
+When `nil' there is no limit."
+ :group 'erlang
+ :type '(restricted-sexp :match-alternatives (integerp 'nil))
+ :safe (lambda (val) (or (eq val nil) (integerp val))))
+
(defvar erlang-man-inhibit (eq system-type 'windows-nt)
"Inhibit the creation of the Erlang Manual Pages menu.
@@ -3689,10 +3696,13 @@ When an identifier is found return a list with 4 elements:
module or nil.
2. Module - Module name string or nil. In case of a
-qualified-function a search fails if no entries with correct
-module are found. For other kinds the module is just a
-preference. If no matching entries are found the search will be
-retried without regard to module.
+qualified-function the module is explicitly specified (like
+module:fun()) and the search fails if no entries with correct
+module are found. For other kinds the module is guessed: either
+fetched from import statements or it is assumed to be the local
+module. In these cases the module is just a preference. If no
+matching entries are found the search will be retried without
+regard to module.
3. Name - String name of function, module, record or macro.
@@ -3704,18 +3714,22 @@ of arguments could be found, otherwise nil."
(if (eq (char-syntax (following-char)) ? )
(skip-chars-backward " \t"))
(skip-chars-backward "[:word:]_:'")
- (cond ((looking-at erlang-module-function-regexp)
+ (cond ((and (eq (preceding-char) ??)
+ (looking-at (concat "\\(MODULE\\):" erlang-atom-regexp)))
+ (erlang-get-qualified-function-id-at-point (erlang-get-module)))
+ ((looking-at erlang-module-function-regexp)
(erlang-get-qualified-function-id-at-point))
((looking-at (concat erlang-atom-regexp ":"))
(erlang-get-module-id-at-point))
((looking-at erlang-name-regexp)
(erlang-get-some-other-id-at-point)))))))
-(defun erlang-get-qualified-function-id-at-point ()
+(defun erlang-get-qualified-function-id-at-point (&optional module)
(let ((kind 'qualified-function)
- (module (erlang-remove-quotes
- (buffer-substring-no-properties
- (match-beginning 1) (match-end 1))))
+ (module (or module
+ (erlang-remove-quotes
+ (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1)))))
(name (erlang-remove-quotes
(buffer-substring-no-properties
(match-beginning (1+ erlang-atom-regexp-matches))
@@ -3825,7 +3839,8 @@ of arguments could be found, otherwise nil."
(let ((case-fold-search nil)) ; force string matching to be case sensitive
(if (and (stringp str)
(not (string-match (eval-when-compile
- (concat "\\`" erlang-atom-regexp "\\'")) str)))
+ (concat "\\`" erlang-atom-regexp "\\'"))
+ str)))
(progn
(setq str (replace-regexp-in-string "'" "\\'" str t t ))
(concat "'" str "'"))
@@ -4879,15 +4894,36 @@ about Erlang modules."
;; The backend below is a wrapper around the built-in etags backend.
;; It adds awareness of the module:tag syntax in a similar way that is
;; done above for the old etags commands.
+;;
+;; In addition arity is also considered when jumping to definitions.
+;; There is however currently no information about arity in the TAGS
+;; file. Also two functions with the same name but different arity
+;; _sometimes_ get one TAGS entry each and sometimes are joined in one
+;; single entry. If they are directly consecutive they will be
+;; joined. If there are other functions etc in between then they will
+;; get one entry each.
+;;
+;; These limitations are present in both the etags program shipped
+;; with GNU Emacs and the tags.erl program in this repository.
+;;
+;; Therefore erlang.el must complement the information in TAGS by
+;; visiting files and checking arity. When searching for popular
+;; function names (like init, handle_call etc) in a big TAGS file
+;; (like one indexing this repository) this may be quite
+;; time-consuming. There exists therefore an upper limit for the
+;; number of files to visit (called
+;; `erlang-max-files-to-visit-for-refining-xrefs').
+;;
+;; As mentioned this xref implementation is based on the etags xref
+;; implementation. But in the cases where arity is considered the
+;; etags information structures (class xref-etags-location) will be
+;; translated to our own structures which include arity (class
+;; erlang-xref-location). This translation is started in the function
+;; `erlang-refine-xrefs'.
-(defvar erlang-current-arity nil
- "The arity of the function currently being searched.
-
-There is no information about arity in the TAGS file.
-Consecutive functions with same name but different arity will
-only get one entry in the TAGS file. Matching TAGS entries are
-therefore selected without regarding arity. The arity is
-considered first when it is time to jump to the definition.")
+;; I mention this as a head up that some of the functions below deal
+;; with xref items with xref-etags-location and some deal with xref
+;; items with erlang-xref-location.
(defun erlang-etags--xref-backend () 'erlang-etags)
@@ -4895,127 +4931,80 @@ considered first when it is time to jump to the definition.")
(when (locate-library (symbol-name feature))
(require feature)))
-(and (erlang-soft-require 'xref)
- (erlang-soft-require 'cl-generic)
- (erlang-soft-require 'eieio)
- (erlang-soft-require 'etags)
- ;; The purpose of using eval here is to avoid compilation
- ;; warnings in emacsen without cl-defmethod etc.
- (eval
- '(progn
- (cl-defmethod xref-backend-identifier-at-point
- ((_backend (eql erlang-etags)))
- (if (eq this-command 'xref-find-references)
- (if (use-region-p)
- (buffer-substring-no-properties (region-beginning)
- (region-end))
- (thing-at-point 'symbol))
- (erlang-id-to-string (erlang-get-identifier-at-point))))
-
- (cl-defmethod xref-backend-definitions
- ((_backend (eql erlang-etags)) identifier)
- (erlang-xref-find-definitions identifier))
-
- (cl-defmethod xref-backend-apropos
- ((_backend (eql erlang-etags)) identifier)
- (erlang-xref-find-definitions identifier t))
-
- (cl-defmethod xref-backend-identifier-completion-table
- ((_backend (eql erlang-etags)))
- (let ((erlang-replace-etags-tags-completion-table t))
- (tags-completion-table)))
-
- (defclass erlang-xref-location (xref-etags-location) ())
-
- (defun erlang-convert-xrefs (xrefs)
- (mapcar (lambda (xref)
- (oset xref location (erlang-make-location
- (oref xref location)))
- xref)
- xrefs))
-
- (defun erlang-make-location (etags-location)
- (with-slots (tag-info file) etags-location
- (make-instance 'erlang-xref-location :tag-info tag-info
- :file file)))
-
- (cl-defmethod xref-location-marker ((locus erlang-xref-location))
- (with-slots (tag-info file) locus
- (with-current-buffer (find-file-noselect file)
- (save-excursion
- (or (erlang-goto-tag-location-by-arity tag-info)
- (etags-goto-tag-location tag-info))
- ;; Reset erlang-current-arity. We want to jump to
- ;; correct arity in the first attempt. That is now
- ;; done. Possible remaining jumps will be from
- ;; entries in the *xref* buffer and then we want to
- ;; ignore the arity. (Alternatively we could remove
- ;; all but one xref entry per file when we know the
- ;; arity).
- (setq erlang-current-arity nil)
- (point-marker)))))
-
- (defun erlang-xref-context (xref)
- (with-slots (tag-info) (xref-item-location xref)
- (car tag-info))))))
-
-
-(defun erlang-goto-tag-location-by-arity (tag-info)
- (when erlang-current-arity
- (let* ((tag-text (car tag-info))
- (tag-pos (cdr (cdr tag-info)))
- (tag-line (car (cdr tag-info)))
- (regexp (erlang-tag-info-regexp tag-text))
- (startpos (or tag-pos
- (when tag-line
- (goto-char (point-min))
- (forward-line (1- tag-line))
- (point))
- (point-min))))
- (setq startpos (max (- startpos 2000)
- (point-min)))
- (goto-char startpos)
- (let ((pos (or (erlang-search-by-arity regexp)
- (unless (eq startpos (point-min))
- (goto-char (point-min))
- (erlang-search-by-arity regexp)))))
- (when pos
- (goto-char pos)
- t)))))
-
-(defun erlang-tag-info-regexp (tag-text)
- (concat "^"
- (regexp-quote tag-text)
- ;; Erlang function entries in TAGS includes the opening
- ;; parenthesis for the argument list. Erlang macro entries
- ;; do not. Add it here in order to end up in correct
- ;; position for erlang-get-arity.
- (if (string-prefix-p "-define" tag-text)
- "\\s-*("
- "")))
-
-(defun erlang-search-by-arity (regexp)
- (let (pos)
- (while (and (null pos)
- (re-search-forward regexp nil t))
- (when (eq erlang-current-arity (save-excursion (erlang-get-arity)))
- (setq pos (point-at-bol))))
- pos))
-
-
+(when (and (erlang-soft-require 'xref)
+ (erlang-soft-require 'cl-generic)
+ (erlang-soft-require 'eieio)
+ (erlang-soft-require 'etags))
+ ;; The purpose of using eval here is to avoid compilation
+ ;; warnings in emacsen without cl-defmethod etc.
+ (eval
+ '(progn
+ (cl-defmethod xref-backend-identifier-at-point ((_backend
+ (eql erlang-etags)))
+ (if (eq this-command 'xref-find-references)
+ (if (use-region-p)
+ (buffer-substring-no-properties (region-beginning)
+ (region-end))
+ (thing-at-point 'symbol))
+ (erlang-id-to-string (erlang-get-identifier-at-point))))
+
+ (cl-defmethod xref-backend-definitions ((_backend (eql erlang-etags))
+ identifier)
+ (erlang-xref-find-definitions identifier))
+
+ (cl-defmethod xref-backend-apropos ((_backend (eql erlang-etags))
+ identifier)
+ (erlang-xref-find-definitions identifier t))
+
+ (cl-defmethod xref-backend-identifier-completion-table
+ ((_backend (eql erlang-etags)))
+ (let ((erlang-replace-etags-tags-completion-table t))
+ (tags-completion-table)))
+
+ (defclass erlang-xref-location (xref-file-location)
+ ((arity :type fixnum :initarg :arity
+ :reader erlang-xref-location-arity))
+ :documentation "An erlang location is a file location plus arity.")
+
+ ;; This method definition only calls the superclass which is
+ ;; the default behaviour if it was not defined. It is only
+ ;; needed for "upgrade" purposes. In version 2.8.1 of
+ ;; erlang.el this method was defined differently and in case
+ ;; user switch to a new erlang.el without restarting Emacs
+ ;; this method needs to be redefined.
+ (cl-defmethod xref-location-marker ((locus erlang-xref-location))
+ (cl-call-next-method locus)))))
+
+;; If this function returns a single xref the user will jump to that
+;; directly. If two or more xrefs are returned a *xref* window is
+;; displayed and the user can choose where to jump. Hence we want to
+;; return a single xref when we are pretty sure that is where the user
+;; wants to go. Otherwise return all possible xrefs but sort them so
+;; that xrefs in the local file is first and if arity is known sort
+;; the xrefs with matching arity before others.
+
+;; Note that the arity sorting work may partly be undone later when
+;; the hits are presented in the *xref* buffer since they then will be
+;; grouped together by file. Ie when one file have one hit with
+;; correct arity and others with wrong arity these hits will be
+;; grouped together and may end up before hits with correct arity.
(defun erlang-xref-find-definitions (identifier &optional is-regexp)
(erlang-with-id (kind module name arity) identifier
- (setq erlang-current-arity arity)
(cond ((eq kind 'module)
(erlang-xref-find-definitions-module name))
+ ((eq kind 'qualified-function)
+ (erlang-xref-find-definitions-qualified-function module
+ name
+ arity
+ is-regexp))
(module
- (erlang-xref-find-definitions-module-tag module
+ (erlang-xref-find-definitions-module-tag kind
+ module
name
- (eq kind
- 'qualified-function)
+ arity
is-regexp))
(t
- (erlang-xref-find-definitions-tag kind name is-regexp)))))
+ (erlang-xref-find-definitions-tag kind name arity is-regexp)))))
(defun erlang-xref-find-definitions-module (module)
(and (fboundp 'xref-make)
@@ -5040,65 +5029,252 @@ considered first when it is time to jump to the definition.")
(setq files (cdr files))))))
(nreverse xrefs))))
-(defun erlang-visit-tags-table-buffer (cont cbuf)
- (if (< emacs-major-version 26)
- (visit-tags-table-buffer cont)
- ;; Remove this with-no-warnings when Emacs 26 is the required
- ;; version minimum.
- (with-no-warnings
- (visit-tags-table-buffer cont cbuf))))
-
-(defun erlang-xref-find-definitions-module-tag (module
+(defun erlang-xref-find-definitions-qualified-function (module
+ tag
+ arity
+ is-regexp)
+ "Find definitions of TAG in MODULE preferably with arity ARITY.
+If one single perfect match was found return only that (ignoring
+other definitions matching TAG). If IS-REGEXP is non-nil then
+TAG is a regexp."
+ (let* ((xrefs (when (fboundp 'etags--xref-find-definitions)
+ (etags--xref-find-definitions tag is-regexp)))
+ (xrefs-split (erlang-split-xrefs-on-module xrefs module))
+ (module-xrefs (car xrefs-split))
+ (module-xrefs (erlang-refine-xrefs module-xrefs
+ 'qualified-function
+ tag
+ is-regexp)))
+ (or (erlang-single-arity-match module-xrefs arity)
+ (erlang-sort-by-arity module-xrefs arity))))
+
+
+;; We will end up here when erlang-get-some-other-id-at-point either
+;; found module among the import statements or module is just the
+;; current local file.
+(defun erlang-xref-find-definitions-module-tag (kind
+ module
tag
- is-qualified
+ arity
is-regexp)
- "Find definitions of TAG and filter away definitions outside of
-MODULE. If IS-QUALIFIED is nil and no definitions was found inside
-the MODULE then return any definitions found outside. If
-IS-REGEXP is non-nil then TAG is a regexp."
- (and (fboundp 'etags--xref-find-definitions)
- (fboundp 'erlang-convert-xrefs)
- (let ((xrefs (erlang-convert-xrefs
- (etags--xref-find-definitions tag is-regexp)))
- xrefs-in-module)
- (dolist (xref xrefs)
- (when (string-equal module (erlang-xref-module xref))
- (push xref xrefs-in-module)))
- (cond (is-qualified xrefs-in-module)
- (xrefs-in-module xrefs-in-module)
- (t xrefs)))))
-
-(defun erlang-xref-find-definitions-tag (kind tag is-regexp)
- "Find all definitions of TAG and reorder them so that
-definitions in the currently visited file comes first."
- (and (fboundp 'etags--xref-find-definitions)
- (fboundp 'erlang-convert-xrefs)
- (let* ((current-file (and (buffer-file-name)
- (file-truename (buffer-file-name))))
- (regexp (erlang-etags-regexp kind tag is-regexp))
- (xrefs (erlang-convert-xrefs
- (etags--xref-find-definitions regexp t)))
- local-xrefs non-local-xrefs)
- (while xrefs
- (let ((xref (car xrefs)))
- (if (string-equal (erlang-xref-truename-file xref)
- current-file)
- (push xref local-xrefs)
- (push xref non-local-xrefs))
- (setq xrefs (cdr xrefs))))
- (append (reverse local-xrefs)
- (reverse non-local-xrefs)))))
+ "Find definitions of TAG preferably in MODULE and with arity ARITY.
+Return definitions outside MODULE if none are found inside. If
+IS-REGEXP is non-nil then TAG is a regexp.
+
+If one single perfect match was found return only that (ignoring
+other definitions matching TAG)."
+ (let* ((xrefs (when (fboundp 'etags--xref-find-definitions)
+ (etags--xref-find-definitions tag is-regexp)))
+ (xrefs-split (erlang-split-xrefs-on-module xrefs module))
+ (module-xrefs (car xrefs-split))
+ (module-xrefs (erlang-refine-xrefs module-xrefs
+ kind
+ tag
+ is-regexp)))
+ (or (erlang-single-arity-match module-xrefs arity)
+ (erlang-xref-find-definitions-tag kind tag arity is-regexp xrefs))))
+
+(defun erlang-xref-find-definitions-tag (kind
+ tag
+ arity
+ is-regexp
+ &optional xrefs)
+ "Find definitions of TAG preferably in local file and with arity ARITY.
+If one single perfect match was found return only that (ignoring
+other definitions matching TAG). If no such local match was
+found then look for a matching BIF in the same way. If IS-REGEXP
+is non-nil then TAG is a regexp."
+ (let* ((regexp (erlang-etags-regexp kind tag is-regexp))
+ (xrefs (or xrefs
+ (when (fboundp 'etags--xref-find-definitions)
+ (etags--xref-find-definitions regexp t))))
+ (xrefs-split (erlang-split-xrefs xrefs))
+ (local-xrefs (car xrefs-split))
+ (local-xrefs (erlang-refine-xrefs local-xrefs
+ kind
+ tag
+ is-regexp))
+ (bif-xrefs (cadr xrefs-split))
+ (other-xrefs (caddr xrefs-split)))
+ (or (erlang-single-arity-match local-xrefs arity)
+ ;; No local match, look for a matching BIF.
+ (progn
+ (setq bif-xrefs (erlang-refine-xrefs bif-xrefs
+ kind
+ tag
+ is-regexp))
+ (erlang-single-arity-match bif-xrefs arity))
+ (progn
+ (setq other-xrefs (erlang-refine-xrefs other-xrefs
+ kind
+ tag
+ is-regexp))
+ (and (null local-xrefs)
+ (null bif-xrefs)
+ ;; No local of BIF matches at all. Is there a single
+ ;; arity match among the rest?
+ (erlang-single-arity-match other-xrefs arity)))
+ (append (erlang-sort-by-arity local-xrefs arity)
+ (erlang-sort-by-arity bif-xrefs arity)
+ (erlang-sort-by-arity other-xrefs arity)))))
+
+
+(defun erlang-refine-xrefs (xrefs kind tag is-regexp)
+ (if (or (memq kind '(record module))
+ ;; No support for apropos here.
+ is-regexp
+ (erlang-too-many-files-in-xrefs xrefs))
+ xrefs
+ (when (and xrefs
+ (fboundp 'xref-item-location)
+ (fboundp 'xref-location-group)
+ (fboundp 'slot-value))
+ (let (files)
+ (cl-loop for xref in xrefs
+ for loc = (xref-item-location xref)
+ for file = (xref-location-group loc)
+ do (pushnew file files :test 'string-equal))
+ (or (cl-loop for file in files
+ append (erlang-xrefs-in-file file kind tag is-regexp))
+ ;; Failed for some reason. Pretend like it is raining and
+ ;; return the unrefined xrefs.
+ xrefs)))))
+
+(defun erlang-too-many-files-in-xrefs (xrefs)
+ (and erlang-max-files-to-visit-for-refining-xrefs
+ (let ((files-to-visit (delete-dups
+ (mapcar #'erlang-xref-truename-file
+ xrefs))))
+ (if (< (length files-to-visit)
+ erlang-max-files-to-visit-for-refining-xrefs)
+ nil
+ (message (concat "Too many hits to consider arity (see "
+ "`erlang-max-files-to-visit-for-refining-xrefs')"))
+ t))))
+
+(defun erlang-xrefs-in-file (file kind tag is-regexp)
+ (when (fboundp 'make-instance)
+ (with-current-buffer (find-file-noselect file)
+ (save-excursion
+ (goto-char (point-min))
+ (let ((regexp (concat ; "^"
+ (erlang-etags-regexp kind tag is-regexp)
+ "\\s *("))
+ last-arity)
+ (cl-loop while (re-search-forward regexp nil t)
+ for name = (match-string-no-properties 1)
+ for arity = (save-excursion
+ (erlang-get-arity))
+ for loc = (make-instance 'erlang-xref-location
+ :file file
+ :line (line-number-at-pos)
+ :column 0
+ :arity arity)
+ for sum = (erlang-xref-summary kind name arity)
+ when (and arity
+ (not (eq arity last-arity)))
+ collect (make-instance 'xref-item
+ :summary sum
+ :location loc)
+ do (setq last-arity arity)))))))
+
+(defun erlang-xref-summary (kind tag arity)
+ (format "%s%s%s"
+ (if (memq kind '(record macro module))
+ (format "%s " kind)
+ "")
+ tag
+ (if arity (format "/%s" arity) "")))
+
+(defun erlang-single-arity-match (xrefs wanted-arity)
+ "Attempt to find one perfect match.
+
+If we have all information needed to consider arity then return a
+single perfect match or nothing. If there are more than one
+match nothing is returned.
+
+If we don't have all information needed to consider arity just
+return XREFS as is."
+ (if (erlang-should-consider-arity-p xrefs wanted-arity)
+ (let ((nr-matches 0)
+ match)
+ (while (and xrefs
+ (< nr-matches 2))
+ (let* ((xref (car xrefs))
+ (arity (erlang-xref-arity xref)))
+ (when (eq arity wanted-arity)
+ (setq match xref
+ nr-matches (1+ nr-matches)))
+ (setq xrefs (cdr xrefs))))
+ (when (eq nr-matches 1)
+ (list match)))
+ (when (eq (length xrefs) 1)
+ xrefs)))
+
+(defun erlang-sort-by-arity (xrefs wanted-arity)
+ (if (erlang-should-consider-arity-p xrefs wanted-arity)
+ (let (matches non-matches)
+ (while xrefs
+ (let* ((xref (car xrefs))
+ (arity (erlang-xref-arity xref)))
+ (push xref (if (eq arity wanted-arity)
+ matches
+ non-matches))
+ (setq xrefs (cdr xrefs))))
+ (append (reverse matches) (reverse non-matches) xrefs))
+ xrefs))
+
+(defun erlang-should-consider-arity-p (xrefs wanted-arity)
+ (and wanted-arity
+ xrefs
+ (fboundp 'erlang-xref-location-p)
+ (fboundp 'xref-item-location)
+ (erlang-xref-location-p (xref-item-location (car xrefs)))))
(defun erlang-etags-regexp (kind tag is-regexp)
- (let ((tag-regexp (if is-regexp
- tag
- (regexp-quote tag))))
- (cond ((eq kind 'record)
- (concat "-record\\s-*(\\s-*" tag-regexp))
- ((eq kind 'macro)
- (concat "-define\\s-*(\\s-*" tag-regexp))
- (t tag-regexp))))
-
+ (let ((tag-regexp (concat "\\("
+ (if is-regexp
+ tag
+ (regexp-quote tag))
+ "\\)")))
+ (concat (if is-regexp "" "^")
+ (cond ((eq kind 'record)
+ (concat "-record\\s-*(\\s-*" tag-regexp))
+ ((eq kind 'macro)
+ (concat "-define\\s-*(\\s-*" tag-regexp))
+ (t
+ tag-regexp))
+ (if is-regexp "" "\\_>"))))
+
+(defun erlang-xref-arity (xref)
+ (and (fboundp 'erlang-xref-location-arity)
+ (fboundp 'xref-item-location)
+ (erlang-xref-location-arity (xref-item-location xref))))
+
+(defun erlang-split-xrefs-on-module (xrefs module)
+ (let (local-xrefs non-local-xrefs)
+ (dolist (xref xrefs)
+ (if (string-equal (erlang-xref-module xref)
+ module)
+ (push xref local-xrefs)
+ (push xref non-local-xrefs)))
+ (cons (reverse local-xrefs)
+ (reverse non-local-xrefs))))
+
+(defun erlang-split-xrefs (xrefs)
+ (let ((current-file (and (buffer-file-name)
+ (file-truename (buffer-file-name))))
+ local-xrefs bif-xrefs other-xrefs)
+ (dolist (xref xrefs)
+ (cond ((string-equal (erlang-xref-truename-file xref) current-file)
+ (push xref local-xrefs))
+ ((string-equal (erlang-xref-module xref) "erlang")
+ (push xref bif-xrefs))
+ (t
+ (push xref other-xrefs))))
+ (list (reverse local-xrefs)
+ (reverse bif-xrefs)
+ (reverse other-xrefs))))
(defun erlang-xref-module (xref)
(erlang-get-module-from-file-name (erlang-xref-file xref)))
@@ -5113,7 +5289,13 @@ definitions in the currently visited file comes first."
(fboundp 'xref-item-location)
(xref-location-group (xref-item-location xref))))
-
+(defun erlang-visit-tags-table-buffer (cont cbuf)
+ (if (< emacs-major-version 26)
+ (visit-tags-table-buffer cont)
+ ;; Remove this with-no-warnings when Emacs 26 is the required
+ ;; version minimum.
+ (with-no-warnings
+ (visit-tags-table-buffer cont cbuf))))
;;;
;;; Prepare for other methods to run an Erlang slave process.
diff --git a/lib/tools/test/emacs_SUITE.erl b/lib/tools/test/emacs_SUITE.erl
index a6d43d1816..8756a4e9b3 100644
--- a/lib/tools/test/emacs_SUITE.erl
+++ b/lib/tools/test/emacs_SUITE.erl
@@ -70,19 +70,20 @@ bif_highlight(Config) ->
check_bif_highlight(Bin, Tag, Compare) ->
- [_H,IntMatch,_T] =
+ [_H,Match,_T] =
re:split(Bin,<<"defvar ",Tag/binary,
"[^(]*\\(([^)]*)">>,[]),
- EmacsIntBifs = [list_to_atom(S) ||
- S <- string:tokens(binary_to_list(IntMatch)," '\"\n")],
+ EmacsBifs = [list_to_atom(S) ||
+ S <- string:tokens(binary_to_list(Match)," '\"\n")],
- ct:log("Emacs ~p",[EmacsIntBifs]),
- ct:log("Int ~p",[Compare]),
+ ct:log("Comparing ~s", [Tag]),
+ ct:log("Emacs ~p",[EmacsBifs]),
+ ct:log("Erlang ~p",[Compare]),
- ct:log("Diff1 ~p",[Compare -- EmacsIntBifs]),
- ct:log("Diff2 ~p",[EmacsIntBifs -- Compare]),
- [] = Compare -- EmacsIntBifs,
- [] = EmacsIntBifs -- Compare.
+ ct:log("Only in Erlang ~p",[Compare -- EmacsBifs]),
+ ct:log("Only in Emacs ~p",[EmacsBifs -- Compare]),
+ [] = Compare -- EmacsBifs,
+ [] = EmacsBifs -- Compare.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -188,7 +189,9 @@ diff(Orig, File) ->
end.
emacs_version_ok(AcceptVer) ->
- case os:cmd("emacs --version | head -1") of
+ VersionLine = os:cmd("emacs --version | head -1"),
+ io:format("~s~n", [VersionLine]),
+ case VersionLine of
"GNU Emacs " ++ Ver ->
case string:to_float(Ver) of
{Vsn, _} when Vsn >= AcceptVer ->
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-17 00:54:52 +0000