Merge branch 'sverker/23/fix-hopeful-fun-size-encoding/OTP-18104'

into sverker/24/fix-hopeful-fun-size-encoding/OTP-18104

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;