From c013f8b647c29a41f351a91825906861f01d13ca Mon Sep 17 00:00:00 2001
From: Patrik Nyblom <pan@erlang.org>
Date: Tue, 11 Jun 2013 12:26:28 +0200
Subject: Add testcase to stress extra_root
---
erts/emulator/test/binary_SUITE.erl | 38 ++++++++++++++++++++++++++++++++++---
1 file changed, 35 insertions(+), 3 deletions(-)
(limited to 'erts/emulator')
diff --git a/erts/emulator/test/binary_SUITE.erl b/erts/emulator/test/binary_SUITE.erl
index babdb3363f..1e924a0fee 100644
--- a/erts/emulator/test/binary_SUITE.erl
+++ b/erts/emulator/test/binary_SUITE.erl
@@ -57,10 +57,10 @@
ordering/1,unaligned_order/1,gc_test/1,
bit_sized_binary_sizes/1,
otp_6817/1,deep/1,obsolete_funs/1,robustness/1,otp_8117/1,
- otp_8180/1]).
+ otp_8180/1, ttb_trap/1]).
%% Internal exports.
--export([sleeper/0]).
+-export([sleeper/0,ttb_loop/2]).
suite() -> [{ct_hooks,[ts_install_cth]},
{timetrap,{minutes,2}}].
@@ -75,7 +75,7 @@ all() ->
bad_term_to_binary, more_bad_terms, otp_5484, otp_5933,
ordering, unaligned_order, gc_test,
bit_sized_binary_sizes, otp_6817, otp_8117, deep,
- obsolete_funs, robustness, otp_8180].
+ obsolete_funs, robustness, otp_8180, ttb_trap].
groups() ->
[].
@@ -1322,6 +1322,38 @@ run_otp_8180(Name) ->
end || Bin <- Bins],
ok.
+%% Test that exit and GC during term_to_binary trap does not crash.
+ttb_trap(Config) when is_list(Config)->
+ case erlang:system_info(wordsize) of
+ N when N < 8 ->
+ {skipped, "Only on 64bit machines"};
+ _ ->
+ do_ttb_trap(5)
+ end.
+
+do_ttb_trap(0) ->
+ ok;
+do_ttb_trap(N) ->
+ Pid = spawn(?MODULE,ttb_loop,[1000,self()]),
+ receive ok -> ok end,
+ receive after 100 -> ok end,
+ erlang:garbage_collect(Pid),
+ receive after 100 -> ok end,
+ exit(Pid,kill),
+ receive after 1 -> ok end,
+ do_ttb_trap(N-1).
+
+ttb_loop(N,Pid) ->
+ Term = lists:duplicate(2000000,2000000),
+ Pid ! ok,
+ ttb_loop2(N,Term).
+ttb_loop2(0,_T) ->
+ ok;
+ttb_loop2(N,T) ->
+ apply(erlang,term_to_binary,[T]),
+ ttb_loop2(N-1,T).
+
+
%% Utilities.
make_sub_binary(Bin) when is_binary(Bin) ->
--
cgit v1.2.3