File 1422-erts-Add-erts_debug_SUITE-t_copy_shared.patch of Package erlang

Overview Repositories Revisions Requests Users Attributes Meta

File 1422-erts-Add-erts_debug_SUITE-t_copy_shared.patch of Package erlang (Revision 3713767a038ae3acd54a990b0e65a761)

Currently displaying revision 3713767a038ae3acd54a990b0e65a761 , Show latest

From 610da14773aa9d8761e3830d76c8fd03be7efca3 Mon Sep 17 00:00:00 2001
From: Sverker Eriksson <sverker@erlang.org>
Date: Tue, 12 Oct 2021 12:36:01 +0200
Subject: [PATCH 2/2] erts: Add erts_debug_SUITE:t_copy_shared

to test the sharing preserve copy for combinations of
different term types and degrees of sharing.
---
 erts/emulator/test/erts_debug_SUITE.erl | 131 ++++++++++++++++++++++++
 1 file changed, 131 insertions(+)

diff --git a/erts/emulator/test/erts_debug_SUITE.erl b/erts/emulator/test/erts_debug_SUITE.erl
index 2c1e83dbdf..2e0373e34f 100644
--- a/erts/emulator/test/erts_debug_SUITE.erl
+++ b/erts/emulator/test/erts_debug_SUITE.erl
@@ -25,16 +25,19 @@
 -export([all/0, suite/0, groups/0,
          test_size/1,flat_size_big/1,df/1,term_type/1,
          instructions/1, stack_check/1, alloc_blocks_size/1,
+         t_copy_shared/1,
          interpreter_size_bench/1]).
 
 -export([do_alloc_blocks_size/0]).
 
+
 suite() ->
     [{ct_hooks,[ts_install_cth]},
      {timetrap, {minutes, 2}}].
 
 all() -> 
     [test_size, flat_size_big, df, instructions, term_type,
+     t_copy_shared,
      stack_check, alloc_blocks_size].
 
 groups() -> 
@@ -291,3 +294,131 @@ mk_ext_port({NodeName, Creation}, Number) ->
 
 mk_ext_ref({NodeName, Creation}, Numbers) ->
     erts_test_utils:mk_ext_ref({NodeName, Creation}, Numbers).
+
+
+t_copy_shared(_Config) ->
+    rand:seed(default),
+    io:format("*** SEED: ~p ***\n", [rand:export_seed()]),
+
+    [copy_shared_term_1(N div 10, CL) || N <- lists:seq(1,100),
+                                         CL <- [false, true]],
+    ok.
+
+copy_shared_term_1(Size, CopyLit) ->
+    Term = rand_term(Size),
+
+    %% Note: Printing Term may suppress test failure
+    %%       as it sends a copy to io-server.
+    %%io:format("rand_term(~p): ~p\n", [Size, printable(Term)]),
+
+    Binary = term_to_binary(Term),
+    Copy = erts_debug:copy_shared(Term, CopyLit),
+    test_eq(Term, Copy),
+    copy_shared_term_2(Copy, Binary).
+
+copy_shared_term_2(Copy, Binary) ->
+    erlang:garbage_collect(),
+    BinCopy = binary_to_term(Binary),
+    test_eq(Copy, BinCopy),
+    ok.
+
+test_eq(A, B) ->
+    case A of
+        B -> ok;
+        _ -> test_eq_fail("FAILED MATCH", A, B)
+    end,
+    case A == B of
+        true -> ok;
+        false -> test_eq_fail("FAILED EQUALITY", A, B)
+    end.
+
+test_eq_fail(Error, A, B) ->
+    io:format("~s:\n\nA = ~p\n\nB = ~p\n",
+              [Error, printable(A), printable(B)]),
+    ct:fail(Error).
+
+rand_term(Size) ->
+    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,
+             [], {}, #{},
+             "literal cons",
+             {"literal boxed"},
+             fun lists:sort/1,
+             fun() -> F 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, Size).
+
+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.
+
+
+%% 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.
-- 
2.31.1

Places

File 1422-erts-Add-erts_debug_SUITE-t_copy_shared.patch of Package erlang (Revision 3713767a038ae3acd54a990b0e65a761)

Places