diff options
author | Sverker Eriksson <sverker@erlang.org> | 2022-06-08 14:25:26 +0200 |
---|---|---|
committer | Sverker Eriksson <sverker@erlang.org> | 2022-06-08 14:50:11 +0200 |
commit | b2d78f7e5124e80d2f38fda78a915d857daaff3c (patch) | |
tree | e530752bf25159952d48f43cf284d2452f8c6bba /lib/erl_interface | |
parent | 0863bd30aabd035c83158c78046c5ffda16127e1 (diff) | |
parent | 9c0b04f95628d6d11d8ea60230f0bc6306d03954 (diff) | |
download | erlang-b2d78f7e5124e80d2f38fda78a915d857daaff3c.tar.gz |
Merge branch 'sverker/23/fix-hopeful-fun-size-encoding/OTP-18104'
into sverker/24/fix-hopeful-fun-size-encoding/OTP-18104
Diffstat (limited to 'lib/erl_interface')
-rw-r--r-- | lib/erl_interface/test/all_SUITE_data/ei_runner.h | 1 | ||||
-rw-r--r-- | lib/erl_interface/test/ei_accept_SUITE.erl | 211 | ||||
-rw-r--r-- | lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c | 19 | ||||
-rw-r--r-- | lib/erl_interface/test/runner.erl | 15 |
4 files changed, 237 insertions, 9 deletions
diff --git a/lib/erl_interface/test/all_SUITE_data/ei_runner.h b/lib/erl_interface/test/all_SUITE_data/ei_runner.h index 6d6e0717e8..2b52225d33 100644 --- a/lib/erl_interface/test/all_SUITE_data/ei_runner.h +++ b/lib/erl_interface/test/all_SUITE_data/ei_runner.h @@ -54,6 +54,7 @@ void free_packet(char*); #define fail(reason) do_fail(__FILE__, __LINE__, reason) #define fail1(reason, a1) do_fail(__FILE__, __LINE__, reason, a1) #define fail2(reason, a1, a2) do_fail(__FILE__, __LINE__, reason, a1, a2) +#define fail3(reason, a1, a2, a3) do_fail(__FILE__, __LINE__, reason, a1, a2, a3) #define report(ok) do_report(__FILE__, __LINE__, ok) void do_report(char* file, int line, int ok); diff --git a/lib/erl_interface/test/ei_accept_SUITE.erl b/lib/erl_interface/test/ei_accept_SUITE.erl index 612d6e1b81..ed992c43f0 100644 --- a/lib/erl_interface/test/ei_accept_SUITE.erl +++ b/lib/erl_interface/test/ei_accept_SUITE.erl @@ -26,23 +26,35 @@ -export([all/0, suite/0, init_per_testcase/2, - ei_accept/1, ei_threaded_accept/1, + ei_accept/1, + hopeful_random/1, + ei_threaded_accept/1, monitor_ei_process/1]). +%% Internals +-export([id/1]). + -import(runner, [get_term/1,send_term/2]). + suite() -> [{ct_hooks,[ts_install_cth]}, {timetrap, {seconds, 30}}]. all() -> - [ei_accept, ei_threaded_accept, + [ei_accept, + hopeful_random, + ei_threaded_accept, monitor_ei_process]. init_per_testcase(Case, Config) -> + rand:uniform(), % Make sure rand is initialized and seeded. + %%rand:seed({exsss, [61781477086241372|88832360391433009]}), + io:format("** rand seed = ~p\n", [rand:export_seed()]), runner:init_per_testcase(?MODULE, Case, Config). ei_accept(Config) when is_list(Config) -> + [ei_accept_do(Config, CR, SI) || CR <- [0,21], SI <- [default, ussi]], @@ -61,11 +73,20 @@ ei_accept_do(Config, CompatRel, SockImpl) -> %% We take this opportunity to also test export-funs and bit-strings %% with (ugly) tuple fallbacks in OTP 21 and older. %% Test both toward pending connection and established connection. - RealTerms = [<<1:1>>, fun lists:map/2], + TermsAndFallbacks = + [{<<1:1>>, {<<128>>,1}}, + {fun lists:map/2, {lists,map}}, + + %% Also test funs with hopeful encoding in environment, + %% which lead to incorrect fun size encoding (OTP-18104) + %% toward pending connection. + {fun_with_env(<<1:1>>), fun_with_env({<<128>>,1})}, + {fun_with_env(fun lists:map/2), fun_with_env({lists,map})}], + {RealTerms, Fallbacks} = lists:unzip(TermsAndFallbacks), EncTerms = case CompatRel of 0 -> RealTerms; - 21 -> [{<<128>>,1}, {lists,map}] - end, + 21 -> Fallbacks + end, Self = self(), Funny = fun() -> hello end, @@ -90,6 +111,186 @@ ei_accept_do(Config, CompatRel, SockImpl) -> runner:finish(P), ok. +fun_with_env(Term) -> + Env = ?MODULE:id(Term), + fun() -> Env end. + +id(X) -> X. + + +%% Send random hopeful encoded terms from emulator to c-node +%% and verify correct encoding with/without fallback. +hopeful_random(Config) when is_list(Config) -> + [hopeful_random_do(Config, CR, SI) + || CR <- [0, 21], + SI <- [default, ussi]], + ok. + + +hopeful_random_do(Config, CompatRel, SockImpl) -> + io:format("CompatRel=~p, SockImpl=~p\n", [CompatRel, SockImpl]), + P = runner:start(Config, ?interpret), + 0 = ei_connect_init(P, 42, erlang:get_cookie(), 0, CompatRel, SockImpl), + + Myname = hd(tl(string:tokens(atom_to_list(node()), "@"))), + io:format("Myname ~p ~n", [Myname]), + EINode = list_to_atom("c42@"++Myname), + io:format("EINode ~p ~n", [EINode]), + + Port = 6543, + {ok, ListenFd} = ei_publish(P, Port), + + Terms = [rand_term(10) || _ <- lists:seq(1,10)], + + %% lists:foldl(fun(T,N) -> + %% io:format("Term #~p = ~p\n", [N, printable(T)]), + %% N+1 + %% end, + %% 1, + %% Terms), + + %% Send on pending connection (hopeful encoding) + [{any, EINode} ! T || T <- Terms], + {ok, Fd, Node} = ei_accept(P, ListenFd), + Node = node(), + [match(T, ei_receive(P, Fd), CompatRel) || T <- Terms], + + %% Send again on established connection + [{any, EINode} ! T || T <- Terms], + [match(T, ei_receive(P, Fd), CompatRel) || T <- Terms], + + runner:finish(P), + ok. + + +match(A, B, 0) -> + match(A, B); +match(A, B, 21) -> + match(fallback(printable(A)), + printable(B)). %% B assumed to already be fallback'ed + +match(A, A) -> ok; +match(A, B) -> + io:format("match failed\nA = ~p\nB = ~p\n", [A, B]), + ct:fail("match failed"). + + +%% Convert to fallbacks to bitstrings and export funs. +%% Does not support local funs with environment terms. +fallback(Binary) when is_binary(Binary) -> + Binary; +fallback(BitStr) when is_bitstring(BitStr) -> + TailBits = bit_size(BitStr) rem 8, + PadBits = 8 - TailBits, + {<<BitStr/bits, 0:PadBits>>, TailBits}; +fallback(Fun) when is_function(Fun) -> + FI = erlang:fun_info(Fun), + {type,external} = lists:keyfind(type, 1, FI), + {module, Mod} = lists:keyfind(module, 1, FI), + {name, Func} = lists:keyfind(name, 1, FI), + {Mod, Func}; +fallback([H|T]) -> + [fallback(H)|fallback(T)]; +fallback(Tuple) when is_tuple(Tuple) -> + list_to_tuple(fallback(tuple_to_list(Tuple))); +fallback(Map) when is_map(Map) -> + maps:from_list(fallback(maps:to_list(Map))); +fallback(Leaf) -> + Leaf. + +rand_term(MaxSize) -> + F = rand:uniform(100), % to produce non-literals + Big = 666_701_523_687_345_689_643 * F, + MagicRef = atomics:new(10,[]), + Leafs = {atom, 42, 42.17*F, + Big, -Big, + [], {}, #{}, + fun lists:sort/1, + fun() -> ok end, + self(), + lists:last(erlang:ports()), + make_ref(), + MagicRef, + <<F:(8*10)>>, % HeapBin + <<F:(8*65)>>, % ProcBin + <<F:7>>, % SubBin + HeapBin + <<F:(8*80+1)>>, % SubBin + ProcBin + mk_ext_pid({a@b, 17}, 17, 42), + mk_ext_port({a@b, 21}, 13), + mk_ext_ref({a@b, 42}, [42, 19, 11])}, + rand_term(Leafs, rand:uniform(MaxSize)). + +rand_term(Leafs, Arity) when Arity > 0 -> + Length = rand:uniform(Arity), + List = [rand_term(Leafs, Arity-Length) || _ <- lists:seq(1,Length)], + case rand:uniform(6) of + 1 -> List; + 2 -> list_to_improper_list(List); + 3 -> list_to_tuple(List); + 4 -> list_to_flatmap(List); + 5 -> list_to_hashmap(List); + 6 -> list_to_fun(List) + end; +rand_term(Leafs, 0) -> + element(rand:uniform(size(Leafs)), Leafs). + +list_to_improper_list([A,B|T]) -> + T ++ [A|B]; +list_to_improper_list([H]) -> + [[]|H]. + +list_to_flatmap(List) -> + list_to_map(List, #{}). + +list_to_hashmap(List) -> + HashMap = #{1=>1, 2=>2, 3=>3, 4=>4, 5=>5, 6=>6, 7=>7, 8=>8, 9=>9,10=>0, + 11=>1,12=>2,13=>3,14=>4,15=>5,16=>6,17=>7,18=>8,19=>9,20=>0, + 21=>1,22=>2,23=>3,24=>4,25=>5,26=>6,27=>7,28=>8,29=>9,30=>0, + 31=>1,32=>2,33=>3}, + list_to_map(List, HashMap). + +list_to_map([], Map) -> + Map; +list_to_map([K], Map) -> + Map#{K => K}; +list_to_map([K,V|T], Map) -> + list_to_map(T, Map#{K => V}). + +list_to_fun([X]) -> + fun(A) -> A + X end; +list_to_fun([X, Y]) -> + fun(A) -> A + X + Y end; +list_to_fun([X, Y | T]) -> + fun(A) -> [A+X+Y | T] end. + +mk_ext_pid({NodeName, Creation}, Number, Serial) -> + erts_test_utils:mk_ext_pid({NodeName, Creation}, Number, Serial). + +mk_ext_port({NodeName, Creation}, Number) -> + erts_test_utils:mk_ext_port({NodeName, Creation}, Number). + +mk_ext_ref({NodeName, Creation}, Numbers) -> + erts_test_utils:mk_ext_ref({NodeName, Creation}, Numbers). + +%% Convert local funs to maps to show fun environment +printable(Fun) when is_function(Fun) -> + case erlang:fun_info(Fun, type) of + {type,local} -> + {env, Env} = erlang:fun_info(Fun, env), + #{'fun' => [printable(T) || T <- Env]}; + {type,external} -> + Fun + end; +printable([H|T]) -> + [printable(H)|printable(T)]; +printable(Tuple) when is_tuple(Tuple) -> + list_to_tuple(printable(tuple_to_list(Tuple))); +printable(Map) when is_map(Map) -> + maps:from_list(printable(maps:to_list(Map))); +printable(Leaf) -> + Leaf. + + ei_threaded_accept(Config) when is_list(Config) -> Einode = filename:join(proplists:get_value(data_dir, Config), "eiaccnode"), ei_threaded_accept_do(Einode, default), diff --git a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c index 7cfc0c9da0..f307646ecc 100644 --- a/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c +++ b/lib/erl_interface/test/ei_accept_SUITE_data/ei_accept_test.c @@ -198,10 +198,13 @@ static void cmd_ei_accept(char* buf, int len) static void cmd_ei_receive(char* buf, int len) { + static int call_cnt = 0; ei_x_buff x; erlang_msg msg; long l; int fd, index = 0; + + call_cnt++; if (ei_decode_long(buf, &index, &l) < 0) fail("expected int (fd)"); @@ -215,6 +218,22 @@ static void cmd_ei_receive(char* buf, int len) fail1("ei_xreceive_msg, got==%d", got); break; } + + { + int index = 0; + int skip_ret; + + if (ei_decode_version(x.buff, &index, NULL) != 0) + fail("ei_decode_version failed"); + + skip_ret = ei_skip_term(x.buff, &index); + if (skip_ret != 0) + fail1("ei_skip_term returned %d", skip_ret); + if (index != x.index ) + fail3("ei_skip_term length mismatch %d != %d (call_cnt=%d)\n", + index, x.index, call_cnt); + } + index = 1; send_bin_term(&x); ei_x_free(&x); diff --git a/lib/erl_interface/test/runner.erl b/lib/erl_interface/test/runner.erl index 484890006e..76cbc49907 100644 --- a/lib/erl_interface/test/runner.erl +++ b/lib/erl_interface/test/runner.erl @@ -23,7 +23,7 @@ -export([test/2, test/3, init_per_testcase/3, - start/2, send_term/2, finish/1, send_eot/1, recv_eot/1, + start/2, start/3, send_term/2, finish/1, send_eot/1, recv_eot/1, get_term/1, get_term/2]). -define(default_timeout, 5000). @@ -55,14 +55,21 @@ test(Config, Tc, Timeout) -> %% %% Returns: {ok, Port} -start(Config, {Prog, Tc}) when is_list(Prog), is_integer(Tc) -> - Port = open_port({spawn, prog_cmd(Config, Prog)}, +start(Config, ProgTc) -> + start(Config, ProgTc, []). + +start(Config, {Prog, Tc}, Opt) when is_list(Prog), is_integer(Tc) -> + Port = open_port({spawn, prog_cmd(Config, Prog, Opt)}, [{packet, 4}, exit_status]), Command = [Tc div 256, Tc rem 256], Port ! {self(), {command, Command}}, Port. -prog_cmd(Config, Prog) -> +prog_cmd(Config, Prog0, Opt) -> + Prog = case Opt of + rr -> "rr " ++ Prog0; + [] -> Prog0 + end, case proplists:get_value(valgrind_cmd_fun, Config) of undefined -> Prog; |