1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%% Test the garbage collector (or Memory Recycler)
22
23-module(gc_SUITE).
24
25-include_lib("common_test/include/ct.hrl").
26-include_lib("eunit/include/eunit.hrl").
27
28-export([all/0, suite/0]).
29
30-export([
31    grow_heap/1,
32    grow_stack/1,
33    grow_stack_heap/1,
34    max_heap_size/1,
35    minor_major_gc_option_async/1,
36    minor_major_gc_option_self/1,
37    gc_signal_order/1,
38    gc_dirty_exec_proc/1,
39    alias_signals_in_gc/1
40]).
41
42suite() ->
43    [{ct_hooks,[ts_install_cth]}].
44
45all() ->
46    [grow_heap, grow_stack, grow_stack_heap, max_heap_size,
47    minor_major_gc_option_self,
48    minor_major_gc_option_async, gc_signal_order, gc_dirty_exec_proc,
49    alias_signals_in_gc].
50
51
52%% Produce a growing list of elements,
53%% for X calls, then drop one item per call
54%% until the list is empty.
55grow_heap(Config) when is_list(Config) ->
56    ct:timetrap({minutes, 40}),
57    ok  = grow_heap1(256),
58    ok  = grow_heap1(512),
59    ok  = grow_heap1(1024),
60    ok  = grow_heap1(2048),
61    ok.
62
63grow_heap1(Len) ->
64    io:format("~ngrow_heap with ~p items.",[Len]),
65    show_heap("before:"),
66    grow_heap1([], Len, 0, up),
67    show_heap("after:").
68
69grow_heap1(List, MaxLen, MaxLen, up) ->
70    show_heap("top:"),
71    grow_heap1(List, MaxLen, MaxLen-1, down);
72grow_heap1(List, MaxLen, CurLen, up) ->
73    NewList=[make_arbit()|List],
74    grow_heap1(NewList, MaxLen, CurLen+1, up);
75grow_heap1([], _MaxLen, _, down) ->
76    ok;
77grow_heap1([_|List], MaxLen, CurLen, down) ->
78    C=erlang:unique_integer([positive]),
79    Num     = C rem (length(List))+1,
80    Elem    = lists:nth(Num, List),
81    NewList = lists:delete(Elem, List),
82    grow_heap1(NewList, MaxLen, CurLen-1, down).
83
84
85
86%% Increase and decrease stack size, and
87%% drop off some garbage from time to time.
88grow_stack(Config) when is_list(Config) ->
89    ct:timetrap({minutes, 80}),
90    show_heap("before:"),
91    grow_stack1(200, 0),
92    show_heap("after:"),
93    ok.
94
95grow_stack1(0, _) ->
96    ok;
97grow_stack1(Recs, 0) ->
98%    show_heap("running:"),
99    grow_stack1(Recs-1, Recs),
100    grow_stack1(0,0);
101grow_stack1(Recs, CurRecs) ->
102    grow_stack1(Recs, CurRecs-1),
103    make_arbit(),
104    grow_stack1(1,0),
105    ok.
106
107
108%% Let's see how BEAM handles this one...
109%% While growing the heap, bounces the size of the
110%% stack, and while reducing the heap, bounces the stack usage.
111grow_stack_heap(Config) when is_list(Config) ->
112    ct:timetrap({minutes, 40}),
113    grow_stack_heap1(16),
114    grow_stack_heap1(32),
115    ok.
116
117grow_stack_heap1(MaxLen) ->
118    io:format("~ngrow_stack_heap with ~p items.",[MaxLen]),
119    show_heap("before:"),
120    grow_stack_heap1([], MaxLen, 0, up),
121    show_heap("after:").
122
123grow_stack_heap1(List, MaxLen, MaxLen, up) ->
124    show_heap("top:"),
125    grow_stack_heap1(List, MaxLen, MaxLen-1, down);
126grow_stack_heap1(List, MaxLen, CurLen, up) ->
127    grow_stack1(CurLen*2,0),
128    grow_stack_heap1([make_arbit()|List], MaxLen, CurLen+1, up),
129    ok;
130
131grow_stack_heap1([], _MaxLen, _, down) -> ok;
132grow_stack_heap1([_|List], MaxLen, CurLen, down) ->
133    grow_stack1(CurLen*2,0),
134    C=erlang:unique_integer([positive]),
135    Num=C rem (length(List))+1,
136    Elem=lists:nth(Num, List),
137    NewList=lists:delete(Elem, List),
138    grow_stack_heap1(NewList, MaxLen, CurLen-1, down),
139    ok.
140
141
142%% Create an arbitrary element/term.
143make_arbit() ->
144    {AA,BB,CC}=erlang:timestamp(),
145    A=AA+1, B=BB+1, C=(CC+erlang:unique_integer([positive])) rem 1000000 + 1,
146    New =
147	case C rem 9 of
148	    0 -> make_string((B div C) +5);
149	    1 -> C;
150	    2 -> make_ref();
151	    3 -> self();
152	    4 -> list_to_binary(make_string((C div B) + 12));
153	    5 -> (C*B)/(A+1);
154	    6 -> list_to_tuple(make_string((B div C) +5));
155	    7 -> list_to_atom(make_string(((C div B) rem 254) + 2));
156	    8 -> fun(X) -> {X,AA,make_string((B div C)+10)} end
157	end,
158    New.
159
160%% Create an arbitrary string of a certain length.
161make_string(Length) ->
162    Alph="abcdefghjiklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"++
163	"0123456789",
164    make_string(Alph, Length, []).
165
166make_string(_, 0, Acc) ->
167    Acc;
168make_string(Alph, Length, Acc) ->
169    C=erlang:unique_integer([positive]),
170    Pos=1+(Length*C rem length(Alph)),
171    make_string(Alph, Length-1,
172		[lists:nth(Pos,Alph)|Acc]).
173
174show_heap(String) ->
175    garbage_collect(self()),
176    receive after 1 -> ok end,
177    {heap_size, HSize}=process_info(self(), heap_size),
178    {stack_size, SSize}=process_info(self(), stack_size),
179    io:format("Heap/Stack "++String++"~p/~p", [HSize, SSize]).
180
181%% Test that doing a remote GC that triggers the max heap size
182%% kills the process.
183max_heap_size(_Config) ->
184
185    Pid = spawn_opt(fun long_receive/0,[{max_heap_size, 1024},
186                                        {message_queue_data, on_heap}]),
187    [Pid ! lists:duplicate(I,I) || I <- lists:seq(1,100)],
188    Ref = erlang:monitor(process, Pid),
189
190    %% Force messages to be viewed as part of heap
191    erlang:process_info(Pid, messages),
192
193    %% Do the GC that triggers max heap
194    erlang:garbage_collect(Pid),
195
196    %% Verify that max heap was triggered
197    receive
198        {'DOWN', Ref, process, Pid, killed} -> ok
199    after 5000 ->
200            ct:fail({process_did_not_die, Pid, erlang:process_info(Pid)})
201    end.
202
203long_receive() ->
204    receive
205    after 10000 ->
206            ok
207    end.
208
209minor_major_gc_option_self(_Config) ->
210    %% Try as major, the test process will self-trigger GC
211    check_gc_tracing_around(
212        fun(Pid, Ref) ->
213            Pid ! {gc, Ref, major}
214        end, [gc_major_start, gc_major_end]),
215
216    %% Try as major dirty, the test process will self-trigger GC
217    check_gc_tracing_around(
218        fun(Pid, Ref) ->
219            Pid ! {gc, Ref, major}
220        end, [gc_major_start, gc_major_end],
221      lists:seq(1,128 * 1024)),
222
223    %% Try as minor, the test process will self-trigger GC
224    check_gc_tracing_around(
225        fun(Pid, Ref) ->
226            Pid ! {gc, Ref, minor}
227        end, [gc_minor_start, gc_minor_end]).
228
229minor_major_gc_option_async(_Config) ->
230    %% Try with default option, must be major GC
231    check_gc_tracing_around(
232        fun(Pid, _Ref) ->
233            erlang:garbage_collect(Pid, [])
234        end, [gc_major_start, gc_major_end]),
235
236    %% Try with the 'major' type
237    check_gc_tracing_around(
238        fun(Pid, _Ref) ->
239            erlang:garbage_collect(Pid, [{type, major}])
240        end, [gc_major_start, gc_major_end]),
241
242    %% Try with 'minor' option, once
243    check_gc_tracing_around(
244        fun(Pid, _Ref) ->
245            erlang:garbage_collect(Pid, [{type, minor}])
246        end, [gc_minor_start, gc_minor_end]),
247
248    %% Try with 'minor' option, once, async
249    check_gc_tracing_around(
250        fun(Pid, Ref) ->
251            ?assertEqual(async,
252                erlang:garbage_collect(Pid, [{type, minor}, {async, Ref}])),
253
254            receive
255                {garbage_collect, Ref, true} ->
256                    ok
257            after 10000 ->
258                ct:fail("Did not receive a completion notification on async GC")
259            end
260        end, [gc_minor_start, gc_minor_end]).
261
262gc_signal_order(Config) when is_list(Config) ->
263    process_flag(scheduler, 1),
264    process_flag(priority, high),
265    Ref = make_ref(),
266    Pid = spawn_opt(fun () -> receive after infinity -> ok end end,[{scheduler, 1}]),
267    spam_signals(Pid, 10000),
268    %% EXIT signal *should* arrive...
269    exit(Pid, kill),
270    %% ... before GC signal...
271    async = garbage_collect(Pid, [{async, Ref}]),
272    %% ... which means that the result of the gc *should* be 'false'...
273    false = busy_wait_gc_res(Ref),
274    ok.
275
276busy_wait_gc_res(Ref) ->
277    receive
278	{garbage_collect, Ref, Res} ->
279	    Res
280    after 0 ->
281	    busy_wait_gc_res(Ref)
282    end.
283
284spam_signals(P, N) when N =< 0 ->
285    ok;
286spam_signals(P, N) ->
287    link(P),
288    unlink(P),
289    spam_signals(P, N-2).
290
291gc_dirty_exec_proc(Config) when is_list(Config) ->
292    check_gc_tracing_around(
293      fun(Pid, _Ref) ->
294	      Pid ! {dirty_exec, 1000},
295	      receive after 100 -> ok end,
296	      true = erlang:garbage_collect(Pid, [{type, major}])
297      end, [gc_major_start, gc_major_end]).
298
299%% Traces garbage collection around the given operation, and fails the test if
300%% it results in any unexpected messages or if the expected trace tags are not
301%% received.
302check_gc_tracing_around(Fun, ExpectedTraceTags) ->
303    check_gc_tracing_around(Fun, ExpectedTraceTags, []).
304check_gc_tracing_around(Fun, ExpectedTraceTags, State) ->
305    Ref = erlang:make_ref(),
306    Pid = spawn(
307            fun() ->
308                    (fun Endless(S) ->
309                             receive
310                                 {gc, Ref, Type} ->
311                                     erlang:garbage_collect(self(), [{type, Type}]);
312                                 {dirty_exec, Time} ->
313                                     erts_debug:dirty_io(wait, Time)
314                             after 100 ->
315                                     ok
316                             end,
317                             Endless(S)
318                     end)(State)
319            end),
320    erlang:garbage_collect(Pid, []),
321    erlang:trace(Pid, true, [garbage_collection]),
322    Fun(Pid, Ref),
323    expect_trace_messages(Pid, ExpectedTraceTags),
324    erlang:trace(Pid, false, [garbage_collection]),
325    erlang:exit(Pid, kill),
326    check_no_unexpected_messages().
327
328%% Ensures that trace messages with the provided tags have all been received
329%% within a reasonable timeframe.
330expect_trace_messages(_Pid, []) ->
331    ok;
332expect_trace_messages(Pid, [Tag | TraceTags]) ->
333    receive
334        {trace, Pid, Tag, _Data} ->
335            expect_trace_messages(Pid, TraceTags)
336    after 4000 ->
337        ct:fail("Didn't receive tag ~p within 4000ms", [Tag])
338    end.
339
340check_no_unexpected_messages() ->
341    receive
342        Anything ->
343            ct:fail("Unexpected message: ~p", [Anything])
344    after 0 ->
345        ok
346    end.
347
348alias_signals_in_gc(Config) when is_list(Config) ->
349    %% Make sure alias signals in rootset wont cause
350    %% crashes...
351    process_flag(scheduler, 1),
352    process_flag(priority, normal),
353    process_flag(message_queue_data, on_heap),
354    Alias = alias(),
355    %% We deactive the alias since it is no point converting
356    %% the alias signals into messages for this test...
357    unalias(Alias),
358    Pid = spawn_opt(fun () ->
359			    alias_sig_spammer(Alias, 100000)
360		    end, [{scheduler, 1}, {priority, high}, link]),
361    erlang:yield(),
362    do_gc(10),
363    unlink(Pid),
364    exit(Pid, bang),
365    false = is_process_alive(Pid),
366    ok.
367
368alias_sig_spammer(Alias, N) ->
369    alias_sig_spammer(Alias, N, N).
370
371alias_sig_spammer(Alias, 0, NStart) ->
372    Alias ! [hello],
373    receive after 100 -> ok end,
374    alias_sig_spammer(Alias, NStart, NStart);
375alias_sig_spammer(Alias, N, NStart) ->
376    Alias ! [hello],
377    alias_sig_spammer(Alias, N-1, NStart).
378
379do_gc(0) ->
380    ok;
381do_gc(N) ->
382    garbage_collect(),
383    receive after 100 -> ok end,
384    do_gc(N-1).
385