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')

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