1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1998-2020. 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-module(seq_trace_SUITE).
21
22%% label_capability_mismatch needs to run a part of the test on an OTP 20 node.
23-compile(r20).
24
25-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
26	 init_per_group/2,end_per_group/2,
27	 init_per_testcase/2,end_per_testcase/2]).
28-export([token_set_get/1, tracer_set_get/1, print/1,
29         old_heap_token/1,mature_heap_token/1,
30	 send/1, distributed_send/1, recv/1, distributed_recv/1,
31	 trace_exit/1, distributed_exit/1, call/1, port/1,
32         port_clean_token/1,
33	 match_set_seq_token/1, gc_seq_token/1, label_capability_mismatch/1,
34         send_literal/1,inherit_on_spawn/1,inherit_on_dist_spawn/1,
35         dist_spawn_error/1]).
36
37%% internal exports
38-export([simple_tracer/2, one_time_receiver/0, one_time_receiver/1,
39         n_time_receiver/1,
40	 start_tracer/0, stop_tracer/1,
41	 do_match_set_seq_token/1, do_gc_seq_token/1, countdown_start/2]).
42
43-include_lib("common_test/include/ct.hrl").
44
45-define(TIMESTAMP_MODES, [no_timestamp,
46			  timestamp,
47			  monotonic_timestamp,
48			  strict_monotonic_timestamp]).
49
50suite() ->
51    [{ct_hooks,[ts_install_cth]},
52     {timetrap,{minutes,1}}].
53
54all() ->
55    [token_set_get, tracer_set_get, print, send, send_literal,
56     distributed_send, recv, distributed_recv, trace_exit,
57     old_heap_token, mature_heap_token,
58     distributed_exit, call, port, match_set_seq_token,
59     port_clean_token,
60     gc_seq_token, label_capability_mismatch,
61     inherit_on_spawn, inherit_on_dist_spawn, dist_spawn_error].
62
63groups() ->
64    [].
65
66init_per_suite(Config) ->
67    Config.
68
69end_per_suite(_Config) ->
70    ok.
71
72init_per_group(_GroupName, Config) ->
73    Config.
74
75end_per_group(_GroupName, Config) ->
76    Config.
77
78
79init_per_testcase(_Case, Config) ->
80    Config.
81
82end_per_testcase(_Case, _Config) ->
83    ok.
84
85%% Verifies that the set_token and get_token functions work as expected
86
87token_set_get(Config) when is_list(Config) ->
88    do_token_set_get(timestamp),
89    do_token_set_get(monotonic_timestamp),
90    do_token_set_get(strict_monotonic_timestamp).
91
92-define(SEQ_TRACE_SEND, 1).                     %(1 << 0)
93-define(SEQ_TRACE_RECEIVE, 2).                  %(1 << 1)
94-define(SEQ_TRACE_PRINT, 4).                    %(1 << 2)
95-define(SEQ_TRACE_NOW_TIMESTAMP, 8).            %(1 << 3)
96-define(SEQ_TRACE_STRICT_MON_TIMESTAMP, 16).    %(1 << 4)
97-define(SEQ_TRACE_MON_TIMESTAMP, 32).           %(1 << 5)
98
99do_token_set_get(TsType) ->
100    BaseOpts = ?SEQ_TRACE_SEND bor
101               ?SEQ_TRACE_RECEIVE bor
102               ?SEQ_TRACE_PRINT,
103    Flags = case TsType of
104        timestamp ->
105            BaseOpts bor ?SEQ_TRACE_NOW_TIMESTAMP;
106        strict_monotonic_timestamp ->
107            BaseOpts bor ?SEQ_TRACE_STRICT_MON_TIMESTAMP;
108        monotonic_timestamp ->
109            BaseOpts bor ?SEQ_TRACE_MON_TIMESTAMP
110        end,
111    ct:pal("Type ~p, flags = ~p~n", [TsType, Flags]),
112    Self = self(),
113    seq_trace:reset_trace(),
114    %% Test that initial seq_trace is disabled
115    [] = seq_trace:get_token(),
116    %% Test setting and reading the different fields
117    0 = seq_trace:set_token(label,{my_label,1}),
118    {label,{my_label,1}} = seq_trace:get_token(label),
119    false = seq_trace:set_token(print,true),
120    {print,true} = seq_trace:get_token(print),
121    false = seq_trace:set_token(send,true),
122    {send,true} = seq_trace:get_token(send),
123    false = seq_trace:set_token('receive',true),
124    {'receive',true} = seq_trace:get_token('receive'),
125    false = seq_trace:set_token(TsType,true),
126    {TsType,true} = seq_trace:get_token(TsType),
127    %% Check the whole token
128    {Flags,{my_label,1},0,Self,0} = seq_trace:get_token(), % all flags are set
129    %% Test setting and reading the 'serial' field
130    {0,0} = seq_trace:set_token(serial,{3,5}),
131    {serial,{3,5}} = seq_trace:get_token(serial),
132    %% Check the whole token, test that a whole token can be set and get
133    {Flags,{my_label,1},5,Self,3} = seq_trace:get_token(),
134    seq_trace:set_token({Flags,19,7,Self,5}),
135    {Flags,19,7,Self,5} = seq_trace:get_token(),
136    %% Check that receive timeout does not reset token
137    receive after 0 -> ok end,
138    {Flags,19,7,Self,5} = seq_trace:get_token(),
139    %% Check that token can be unset
140    {Flags,19,7,Self,5} = seq_trace:set_token([]),
141    [] = seq_trace:get_token(),
142    %% Check that Previous serial counter survived unset token
143    0 = seq_trace:set_token(label, 17),
144    {0,17,0,Self,5} = seq_trace:get_token(),
145    %% Check that reset_trace resets the token and clears
146    %% the Previous serial counter
147    seq_trace:reset_trace(),
148    [] = seq_trace:get_token(),
149    0 = seq_trace:set_token(label, 19),
150    {0,19,0,Self,0} = seq_trace:get_token(),
151    %% Cleanup
152    seq_trace:reset_trace(),
153    ok.
154
155tracer_set_get(Config) when is_list(Config) ->
156    Self = self(),
157    seq_trace:set_system_tracer(self()),
158    Self = seq_trace:get_system_tracer(),
159    Self = seq_trace:set_system_tracer(false),
160    false = seq_trace:get_system_tracer(),
161
162    %% Set the system tracer to a port.
163
164    Port = load_tracer(Config),
165    seq_trace:set_system_tracer(Port),
166    Port = seq_trace:get_system_tracer(),
167    Port = seq_trace:set_system_tracer(false),
168    false = seq_trace:get_system_tracer(),
169    ok.
170
171print(Config) when is_list(Config) ->
172    [do_print(TsType, Label) || TsType <- ?TIMESTAMP_MODES,
173                                Label <- [17, "label"]].
174
175do_print(TsType, Label) ->
176    start_tracer(),
177    seq_trace:set_token(label, Label),
178    set_token_flags([print, TsType]),
179    seq_trace:print(Label,print1),
180    seq_trace:print(1,print2),
181    seq_trace:print(print3),
182    seq_trace:reset_trace(),
183    [{Label,{print,_,_,[],print1}, Ts0},
184     {Label,{print,_,_,[],print3}, Ts1}] = stop_tracer(2),
185    check_ts(TsType, Ts0),
186    check_ts(TsType, Ts1).
187
188send(Config) when is_list(Config) ->
189    lists:foreach(fun do_send/1, ?TIMESTAMP_MODES).
190
191do_send(TsType) ->
192    do_send(TsType, send).
193
194do_send(TsType, Msg) ->
195    seq_trace:reset_trace(),
196    start_tracer(),
197    Tester = self(),
198    Receiver = spawn(fun () ->
199                             A = alias(),
200                             Tester ! {alias, A},
201                             n_time_receiver(3)
202                     end),
203    Alias = receive {alias, A} -> A end,
204    register(n_time_receiver, Receiver),
205    Label = make_ref(),
206    seq_trace:set_token(label,Label),
207    set_token_flags([send, TsType]),
208    Receiver ! Msg,
209    n_time_receiver ! Msg,
210    Alias ! Msg,
211    Self = self(),
212    seq_trace:reset_trace(),
213    [{Label,{send,_,Self,Receiver,Msg}, Ts1},
214     %% Apparently named local destination process is traced as pid (!?)
215     {Label,{send,_,Self,Receiver,Msg}, Ts2},
216     {Label,{send,_,Self,Alias,Msg}, Ts3}
217    ] = stop_tracer(3),
218    check_ts(TsType, Ts1),
219    check_ts(TsType, Ts2),
220    check_ts(TsType, Ts3).
221
222
223%% This testcase tests that we do not segfault when we have a
224%% literal as the message and the message is copied onto the
225%% heap during a GC.
226send_literal(Config) when is_list(Config) ->
227    lists:foreach(fun do_send_literal/1,
228                  [atom, make_ref(), ets:new(hej,[]), 1 bsl 64,
229                   "gurka", {tuple,test,with,#{}}, #{}]).
230
231do_send_literal(Msg) ->
232    N = 10000,
233    seq_trace:reset_trace(),
234    start_tracer(),
235    Label = make_ref(),
236    Receiver = spawn_link(fun() -> receive ok -> ok end end),
237    seq_trace:set_token(label,Label),
238    set_token_flags([send, 'receive', no_timestamp]),
239    [Receiver ! Msg || _ <- lists:seq(1, N)],
240    erlang:garbage_collect(Receiver),
241    [Receiver ! Msg || _ <- lists:seq(1, N)],
242    erlang:garbage_collect(Receiver),
243    Self = self(),
244    seq_trace:reset_trace(),
245    [{Label,{send,_,Self,Receiver,Msg}, Ts} | _] = stop_tracer(N),
246    check_ts(no_timestamp, Ts).
247
248distributed_send(Config) when is_list(Config) ->
249    lists:foreach(fun do_distributed_send/1, ?TIMESTAMP_MODES).
250
251do_distributed_send(TsType) ->
252    {ok,Node} = start_node(seq_trace_other,[]),
253    {_,Dir} = code:is_loaded(?MODULE),
254    Mdir = filename:dirname(Dir),
255    true = rpc:call(Node,code,add_patha,[Mdir]),
256    seq_trace:reset_trace(),
257    start_tracer(),
258    Tester = self(),
259    Receiver = spawn(Node,
260                     fun () ->
261                             A = alias(),
262                             Tester ! {alias, A},
263                             n_time_receiver(3)
264                     end),
265    Alias = receive {alias, A} -> A end,
266    true = rpc:call(Node,erlang,register,[n_time_receiver, Receiver]),
267
268    %% Make sure complex labels survive the trip.
269    Label = make_ref(),
270    seq_trace:set_token(label,Label),
271    set_token_flags([send,TsType]),
272
273    Receiver ! send,
274    {n_time_receiver, Node} ! "dsend",
275    Alias ! "alias_dsend",
276
277    Self = self(),
278    seq_trace:reset_trace(),
279    stop_node(Node),
280    [{Label,{send,_,Self,Receiver,send}, Ts1},
281     {Label,{send,_,Self,{n_time_receiver,Node}, "dsend"}, Ts2},
282     {Label,{send,_,Self,Alias,"alias_dsend"}, Ts3}
283    ] = stop_tracer(3),
284
285    check_ts(TsType, Ts1),
286    check_ts(TsType, Ts2),
287    check_ts(TsType, Ts3).
288
289
290recv(Config) when is_list(Config) ->
291    lists:foreach(fun do_recv/1, ?TIMESTAMP_MODES).
292
293do_recv(TsType) ->
294    seq_trace:reset_trace(),
295    start_tracer(),
296    Tester = self(),
297    Receiver = spawn(fun () ->
298                             A = alias([reply]),
299                             Tester ! {alias, A},
300                             n_time_receiver(2)
301                     end),
302    Alias = receive {alias, A} -> A end,
303    set_token_flags(['receive',TsType]),
304    Alias ! 'alias_receive',
305    Alias ! 'alias_no_receive',
306    Receiver ! 'receive',
307    %% let the other process receive the message:
308    receive after 1 -> ok end,
309    Self = self(),
310    seq_trace:reset_trace(),
311    [{0,{'receive',_,Self,Receiver,'alias_receive'}, Ts1},
312     {0,{'receive',_,Self,Receiver,'receive'}, Ts2}] = stop_tracer(2),
313    check_ts(TsType, Ts1),
314    check_ts(TsType, Ts2).
315
316distributed_recv(Config) when is_list(Config) ->
317    lists:foreach(fun do_distributed_recv/1, ?TIMESTAMP_MODES).
318
319do_distributed_recv(TsType) ->
320    {ok,Node} = start_node(seq_trace_other,[]),
321    {_,Dir} = code:is_loaded(?MODULE),
322    Mdir = filename:dirname(Dir),
323    true = rpc:call(Node,code,add_patha,[Mdir]),
324    seq_trace:reset_trace(),
325    rpc:call(Node,?MODULE,start_tracer,[]),
326    Tester = self(),
327    Receiver = spawn(Node,
328                     fun () ->
329                             A = alias([reply]),
330                             Tester ! {alias, A},
331                             n_time_receiver(2)
332                     end),
333    Alias = receive {alias, A} -> A end,
334
335    %% Make sure complex labels survive the trip.
336    Label = make_ref(),
337    seq_trace:set_token(label,Label),
338    set_token_flags(['receive',TsType]),
339
340    Alias ! 'alias_receive',
341    Alias ! 'alias_no_receive',
342    Receiver ! 'receive',
343
344    %% let the other process receive the message:
345    receive after 1 -> ok end,
346    Self = self(),
347    seq_trace:reset_trace(),
348    Result = rpc:call(Node,?MODULE,stop_tracer,[2]),
349    stop_node(Node),
350    ok = io:format("~p~n",[Result]),
351    [{Label,{'receive',_,Self,Receiver,'alias_receive'}, Ts1},
352     {Label,{'receive',_,Self,Receiver,'receive'}, Ts2}] = Result,
353    check_ts(TsType, Ts1),
354    check_ts(TsType, Ts2).
355
356trace_exit(Config) when is_list(Config) ->
357    lists:foreach(fun do_trace_exit/1, ?TIMESTAMP_MODES).
358
359do_trace_exit(TsType) ->
360    seq_trace:reset_trace(),
361    start_tracer(),
362    Receiver = spawn_link(?MODULE, one_time_receiver, [exit]),
363    process_flag(trap_exit, true),
364
365    %% Make sure complex labels survive the trip.
366    Label = make_ref(),
367    seq_trace:set_token(label,Label),
368    set_token_flags([send, TsType]),
369
370    Receiver ! {before, exit},
371    %% let the other process receive the message:
372    receive
373	      {'EXIT', Receiver, {exit, {before, exit}}} ->
374		  seq_trace:set_token([]);
375	      Other ->
376		  seq_trace:set_token([]),
377		  ct:fail({received, Other})
378	  end,
379    Self = self(),
380    Result = stop_tracer(2),
381    seq_trace:reset_trace(),
382    ok = io:format("~p~n", [Result]),
383    [{Label, {send, {0,1}, Self, Receiver, {before, exit}}, Ts0},
384	   {Label, {send, {1,2}, Receiver, Self,
385	       {'EXIT', Receiver, {exit, {before, exit}}}}, Ts1}] = Result,
386    check_ts(TsType, Ts0),
387    check_ts(TsType, Ts1).
388
389distributed_exit(Config) when is_list(Config) ->
390    lists:foreach(fun do_distributed_exit/1, ?TIMESTAMP_MODES).
391
392do_distributed_exit(TsType) ->
393    {ok, Node} = start_node(seq_trace_other, []),
394    {_, Dir} = code:is_loaded(?MODULE),
395    Mdir = filename:dirname(Dir),
396    true = rpc:call(Node, code, add_patha, [Mdir]),
397    seq_trace:reset_trace(),
398    rpc:call(Node, ?MODULE, start_tracer,[]),
399    Receiver = spawn_link(Node, ?MODULE, one_time_receiver, [exit]),
400    process_flag(trap_exit, true),
401    set_token_flags([send, TsType]),
402    Receiver ! {before, exit},
403    %% let the other process receive the message:
404    receive
405	      {'EXIT', Receiver, {exit, {before, exit}}} ->
406		  seq_trace:set_token([]);
407	      Other ->
408		  seq_trace:set_token([]),
409		  ct:fail({received, Other})
410	  end,
411    Self = self(),
412    Result = rpc:call(Node, ?MODULE, stop_tracer, [1]),
413    seq_trace:reset_trace(),
414    stop_node(Node),
415    ok = io:format("~p~n", [Result]),
416    [{0, {send, {1, 2}, Receiver, Self,
417		{'EXIT', Receiver, {exit, {before, exit}}}}, Ts}] = Result,
418    check_ts(TsType, Ts).
419
420label_capability_mismatch(Config) when is_list(Config) ->
421    Releases = ["20_latest"],
422    Available = [Rel || Rel <- Releases, test_server:is_release_available(Rel)],
423    case Available of
424        [] -> {skipped, "No incompatible releases available"};
425        _ ->
426            lists:foreach(fun do_incompatible_labels/1, Available),
427            lists:foreach(fun do_compatible_labels/1, Available),
428            ok
429    end.
430
431do_incompatible_labels(Rel) ->
432    Cookie = atom_to_list(erlang:get_cookie()),
433    {ok, Node} = test_server:start_node(
434        list_to_atom(atom_to_list(?MODULE)++"_"++Rel), peer,
435        [{args, " -setcookie "++Cookie}, {erl, [{release, Rel}]}]),
436
437    {_,Dir} = code:is_loaded(?MODULE),
438    Mdir = filename:dirname(Dir),
439    true = rpc:call(Node,code,add_patha,[Mdir]),
440    seq_trace:reset_trace(),
441    true = is_pid(rpc:call(Node,?MODULE,start_tracer,[])),
442    Receiver = spawn(Node,?MODULE,one_time_receiver,[]),
443
444    %% This node does not support arbitrary labels, so it must fail with a
445    %% timeout as the token is dropped silently.
446    seq_trace:set_token(label,make_ref()),
447    seq_trace:set_token('receive',true),
448
449    Receiver ! 'receive',
450    %% let the other process receive the message:
451    receive after 10 -> ok end,
452    seq_trace:reset_trace(),
453
454    {error,timeout} = rpc:call(Node,?MODULE,stop_tracer,[1]),
455    stop_node(Node),
456    ok.
457
458do_compatible_labels(Rel) ->
459    Cookie = atom_to_list(erlang:get_cookie()),
460    {ok, Node} = test_server:start_node(
461        list_to_atom(atom_to_list(?MODULE)++"_"++Rel), peer,
462        [{args, " -setcookie "++Cookie}, {erl, [{release, Rel}]}]),
463
464    {_,Dir} = code:is_loaded(?MODULE),
465    Mdir = filename:dirname(Dir),
466    true = rpc:call(Node,code,add_patha,[Mdir]),
467    seq_trace:reset_trace(),
468    true = is_pid(rpc:call(Node,?MODULE,start_tracer,[])),
469    Receiver = spawn(Node,?MODULE,one_time_receiver,[]),
470
471    %% This node does not support arbitrary labels, but small integers should
472    %% still work.
473    Label = 1234,
474    seq_trace:set_token(label,Label),
475    seq_trace:set_token('receive',true),
476
477    Receiver ! 'receive',
478    %% let the other process receive the message:
479    receive after 10 -> ok end,
480    Self = self(),
481    seq_trace:reset_trace(),
482    Result = rpc:call(Node,?MODULE,stop_tracer,[1]),
483    stop_node(Node),
484    ok = io:format("~p~n",[Result]),
485    [{Label,{'receive',_,Self,Receiver,'receive'}, _}] = Result,
486    ok.
487
488call(doc) ->
489    "Tests special forms {is_seq_trace} and {get_seq_token} "
490	"in trace match specs.";
491call(Config) when is_list(Config) ->
492    Self = self(),
493    seq_trace:reset_trace(),
494    TrA = transparent_tracer(),
495    1 =
496	erlang:trace(Self, true,
497		     [call, set_on_spawn, {tracer, TrA(pid)}]),
498    1 =
499	erlang:trace_pattern({?MODULE, call_tracee_1, 1},
500			     [{'_',
501			       [],
502			       [{message, {{{self}, {get_seq_token}}}}]}],
503			     [local]),
504    1 =
505	erlang:trace_pattern({?MODULE, call_tracee_2, 1},
506			     [{'_',
507			      [{is_seq_trace}],
508			      [{message, {{{self}, {get_seq_token}}}}]}],
509			     [local]),
510    RefA = make_ref(),
511    Pid2A = spawn_link(
512		    fun() ->
513			    receive {_, msg, RefA} -> ok end,
514			    RefA = call_tracee_2(RefA),
515			    Self ! {self(), msg, RefA}
516		   end),
517    Pid1A = spawn_link(
518		    fun() ->
519			    receive {_, msg, RefA} -> ok end,
520			    RefA = call_tracee_1(RefA),
521			    Pid2A ! {self(), msg, RefA}
522		    end),
523    Pid1A ! {Self, msg, RefA},
524    %% The message is passed Self -> Pid1B -> Pid2B -> Self.
525    %% Traced functions are called in Pid1B and Pid2B.
526    receive {Pid2A, msg, RefA} -> ok end,
527    %% Only call_tracee1 will be traced since the guard for
528    %% call_tracee2 requires a sequential trace. The trace
529    %% token is undefined.
530    Token2A = [],
531    {ok, [{trace, Pid1A, call,
532		 {?MODULE, call_tracee_1, [RefA]},
533		 {Pid1A, Token2A}}]} =
534	TrA({stop, 1}),
535
536    seq_trace:reset_trace(),
537
538    TrB = transparent_tracer(),
539    1 =
540	erlang:trace(Self, true,
541		     [call, set_on_spawn, {tracer, TrB(pid)}]),
542    RefB = make_ref(),
543    Pid2B = spawn_link(
544		    fun() ->
545			    receive {_, msg, RefB} -> ok end,
546			    RefB = call_tracee_2(RefB),
547			    Self ! {self(), msg, RefB}
548		   end),
549    Pid1B = spawn_link(
550		    fun() ->
551			    receive {_, msg, RefB} -> ok end,
552			    RefB = call_tracee_1(RefB),
553			    Pid2B ! {self(), msg, RefB}
554		    end),
555
556    %% The token is set *AFTER* spawning to make sure we're testing that the
557    %% token follows on send and not that it inherits on spawn.
558    Label = 17,
559    seq_trace:set_token(label, Label),
560
561    Pid1B ! {Self, msg, RefB},
562    %% The message is passed Self -> Pid1B -> Pid2B -> Self, and the
563    %% seq_trace token follows invisibly. Traced functions are
564    %% called in Pid1B and Pid2B. Seq_trace flags == 0 so no
565    %% seq_trace messages are generated.
566    receive {Pid2B, msg, RefB} -> ok end,
567    %% The values of these counters {.., 1, _, 0}, {.., 2, _, 1}
568    %% depend on that seq_trace has been reset just before this test.
569    Token1B = {0, Label, 1, Self, 0},
570    Token2B = {0, Label, 2, Pid1B, 1},
571    {ok, [{trace, Pid1B, call,
572		 {?MODULE, call_tracee_1, [RefB]},
573		 {Pid1B, Token1B}},
574		{trace, Pid2B, call,
575		 {?MODULE, call_tracee_2, [RefB]},
576		 {Pid2B, Token2B}}]} =
577	TrB({stop,2}),
578    seq_trace:reset_trace(),
579    ok.
580
581%% The token should follow spawn, just like it follows messages.
582inherit_on_spawn(Config) when is_list(Config) ->
583    lists:foreach(
584      fun (Test) ->
585              lists:foreach(
586                fun (TraceFlags) ->
587                        inherit_on_spawn_test(Test, TraceFlags)
588                end,
589                combinations(spawn_trace_flags()))
590      end,
591      [spawn, spawn_link, spawn_monitor,
592       spawn_opt, spawn_request]),
593    ok.
594
595inherit_on_spawn_test(Spawn, TraceFlags) ->
596    io:format("Testing ~p() with ~p trace flags~n", [Spawn, TraceFlags]),
597
598    seq_trace:reset_trace(),
599    start_tracer(),
600    start_spawn_tracer(TraceFlags),
601
602    Ref = make_ref(),
603    seq_trace:set_token(label,Ref),
604    set_token_flags([send,'receive',strict_monotonic_timestamp]),
605
606    Self = self(),
607    GurkaMsg = {gurka,Ref},
608    SpawnFun = fun() -> Self ! GurkaMsg, receive after infinity -> ok end end,
609    {Other, Tag, KnownReqId, KnownSpawnReply}
610        = case Spawn of
611              spawn ->
612                  {spawn(SpawnFun), spawn_reply, undefined, undefined};
613              spawn_link ->
614                  {spawn_link(SpawnFun), spawn_reply, undefined, undefined};
615              spawn_monitor ->
616                  {P, _} = spawn_monitor(SpawnFun),
617                  {P, spawn_reply, undefined, undefined};
618              spawn_opt ->
619                  {spawn_opt(SpawnFun, [link]), spawn_reply, undefined, undefined};
620              spawn_request ->
621                  SReply = make_ref(),
622                  RID = spawn_request(SpawnFun, [link, {reply_tag, SReply}]),
623                  receive
624                      {SReply, RID, ok, P} = M ->
625                          {P, SReply, RID, M}
626                  end
627          end,
628
629    receive {gurka,Ref} -> ok end,
630    seq_trace:reset_trace(),
631    erlang:trace(self(),false,[procs|TraceFlags]),
632
633    Sequence = lists:keysort(3, stop_tracer(6)),
634    io:format("Sequence: ~p~n", [Sequence]),
635    [SSpawnRequest, RSpawnRequest, SSpawnReply, RSpawnReply,
636     SGurkaMsg, RGurkaMsg] = Sequence,
637
638    %% Spawn request...
639     {Ref,
640      {send,
641       {0,1},
642       Self,Other,
643       ReqMessage},
644      _} = SSpawnRequest,
645
646    spawn_request = element(1, ReqMessage),
647    ReqId = element(2, ReqMessage),
648    case KnownReqId of
649        undefined -> ok;
650        ReqId -> ok
651    end,
652
653     {Ref,
654      {'receive',
655       {0,1},
656       Self,Other,
657       ReqMessage},
658      _} = RSpawnRequest,
659
660    %% Spawn reply...
661    SpawnReply = {Tag,ReqId,ok,Other},
662    {Ref,
663     {send,
664      {1,2},
665      Other,Self,
666      SpawnReply},
667     _} = SSpawnReply,
668
669    case KnownSpawnReply of
670        undefined -> ok;
671        SpawnReply -> ok
672    end,
673
674    {Ref,
675     {'receive',
676      {1,2},
677      Other,Self,
678      SpawnReply},
679     _} = RSpawnReply,
680
681     %% Gurka message...
682     {Ref,
683      {send,
684       {1,3},
685       Other, Self,
686       GurkaMsg},
687      _} = SGurkaMsg,
688
689     {Ref,
690      {'receive',
691       {1,3},
692       Other, Self,
693       GurkaMsg},
694      _} = RGurkaMsg,
695
696
697    Links = not(spawn =:= spawn orelse Spawn =:= spawn_monitor),
698    SoL = lists:member(set_on_link,TraceFlags) orelse
699        lists:member(set_on_first_link,TraceFlags),
700    SoS = lists:member(set_on_spawn,TraceFlags) orelse
701        lists:member(set_on_first_sapwn,TraceFlags),
702
703    NoTraceMessages =
704        if
705            SoS andalso Links ->
706                4;
707            SoS andalso not Links ->
708                2;
709            SoL andalso Links ->
710                4;
711            SoL andalso not Links->
712                1;
713            Links andalso not SoL andalso not SoS ->
714                2;
715            not Links andalso not SoL andalso not SoS ->
716                1
717        end,
718
719    TraceMessages = stop_spawn_tracer(NoTraceMessages),
720
721    unlink(Other),
722    exit(Other, kill),
723
724
725    ok.
726
727inherit_on_dist_spawn(Config) when is_list(Config) ->
728    lists:foreach(fun (Test) ->
729                          inherit_on_dist_spawn_test(Test)
730                  end,
731                  [spawn, spawn_link, spawn_monitor,
732                   spawn_opt, spawn_request]),
733    ok.
734
735inherit_on_dist_spawn_test(Spawn) ->
736    io:format("Testing ~p()~n", [Spawn]),
737    Pa = "-pa "++filename:dirname(code:which(?MODULE)),
738    {ok, Node} = start_node(seq_trace_dist_spawn, Pa),
739    %% ensure module is loaded on remote node...
740    _ = rpc:call(Node, ?MODULE, module_info, []),
741
742    io:format("Self=~p~n",[self()]),
743
744    seq_trace:reset_trace(),
745    start_tracer(),
746    rpc:call(Node, seq_trace, reset_trace, []),
747    start_tracer(Node),
748
749    Ref = make_ref(),
750    io:format("Ref=~p~n",[Ref]),
751
752    seq_trace:set_token(label,Ref),
753    set_token_flags([send,'receive',strict_monotonic_timestamp]),
754
755    Self = self(),
756
757    GurkaMsg = {gurka,Ref},
758    SpawnFun = fun() -> Self ! GurkaMsg, receive after infinity -> ok end end,
759    {Other, Tag, KnownReqId, KnownSpawnReply}
760        = case Spawn of
761              spawn ->
762                  {spawn(Node, SpawnFun), spawn_reply, undefined, undefined};
763              spawn_link ->
764                  {spawn_link(Node, SpawnFun), spawn_reply, undefined, undefined};
765              spawn_monitor ->
766                  {P, _} = spawn_monitor(Node, SpawnFun),
767                  {P, spawn_reply, undefined, undefined};
768              spawn_opt ->
769                  {spawn_opt(Node, SpawnFun, [link]), spawn_reply, undefined, undefined};
770              spawn_request ->
771                  SReply = make_ref(),
772                  RID = spawn_request(Node, SpawnFun, [{reply_tag, SReply}, link]),
773                  receive
774                      {SReply, RID, ok, P} = M ->
775                          {P, SReply, RID, M}
776                  end
777          end,
778
779    receive GurkaMsg -> ok end,
780    seq_trace:reset_trace(),
781
782    Sequence = lists:keysort(3,stop_tracer(4)),
783    io:format("Sequence: ~p~n", [Sequence]),
784    [StSpawnRequest, StAList, StSpawnReply, StGurkaMsg] = Sequence,
785
786    %% Spawn request...
787     {Ref,
788      {send,
789       {0,1},
790       Self,Node,
791       ReqMessage},
792      _} = StSpawnRequest,
793
794    spawn_request = element(1, ReqMessage),
795    ReqId = element(2, ReqMessage),
796    case KnownReqId of
797        undefined -> ok;
798        ReqId -> ok
799    end,
800
801    {Ref,
802     {send,
803      {0,2},
804      Self,Node,
805      ArgList},
806     _} = StAList,
807
808    %% Spawn reply...
809    SpawnReply = {Tag,ReqId,ok,Other},
810    case KnownSpawnReply of
811        undefined -> ok;
812        SpawnReply -> ok
813    end,
814
815    {Ref,
816     {'receive',
817      {1,2},
818      Other,Self,
819      SpawnReply},
820     _} = StSpawnReply,
821
822     %% Gurka message...
823     {Ref,
824      {'receive',
825       {2,3},
826       Other, Self,
827       GurkaMsg},
828      _} = StGurkaMsg,
829
830    SequenceNode = lists:keysort(3,stop_tracer(Node, 4)),
831    io:format("SequenceNode: ~p~n", [SequenceNode]),
832    [StSpawnRequestNode, StSpawnReplyNode, StAListNode, StGurkaMsgNode] = SequenceNode,
833
834
835    %% Spawn request...
836     {Ref,
837      {'receive',
838       {0,1},
839       Self,Other,
840       ReqMessage},
841      _} = StSpawnRequestNode,
842
843    %% Spawn reply...
844    {Ref,
845     {send,
846      {1,2},
847      Other,Self,
848      {spawn_reply, ReqId, ok, Other}},
849     _} = StSpawnReplyNode,
850
851    {Ref,
852     {'receive',
853      {0,2},
854      Self,Other,
855      ArgList},
856     _} = StAListNode,
857
858     %% Gurka message...
859     {Ref,
860      {send,
861       {2,3},
862       Other, Self,
863       GurkaMsg},
864      _} = StGurkaMsgNode,
865
866    unlink(Other),
867
868    stop_node(Node),
869
870    ok.
871
872dist_spawn_error(Config) when is_list(Config) ->
873    Pa = "-pa "++filename:dirname(code:which(?MODULE)),
874    {ok, Node} = start_node(seq_trace_dist_spawn, Pa),
875    %% ensure module is loaded on remote node...
876    _ = rpc:call(Node, ?MODULE, module_info, []),
877
878    io:format("Self=~p~n",[self()]),
879
880    seq_trace:reset_trace(),
881    start_tracer(),
882    rpc:call(Node, seq_trace, reset_trace, []),
883    start_tracer(Node),
884
885    Ref = make_ref(),
886    io:format("Ref=~p~n",[Ref]),
887
888    seq_trace:set_token(label,Ref),
889    set_token_flags([send,'receive',strict_monotonic_timestamp]),
890
891    Self = self(),
892    SpawnReplyTag = make_ref(),
893    GurkaMsg = {gurka,Ref},
894    ReqId = spawn_request(Node,
895                          fun () ->
896                                  Self ! GurkaMsg,
897                                  receive after infinity -> ok end
898                          end,
899                          [lunk, {reply_tag, SpawnReplyTag}, link]),
900
901    receive
902        {SpawnReplyTag, ReqId, ResType, Err} ->
903            error = ResType,
904            badopt = Err
905    end,
906
907    seq_trace:reset_trace(),
908
909    Sequence = lists:keysort(3,stop_tracer(3)),
910    io:format("Sequence: ~p~n", [Sequence]),
911    [StSpawnRequest, StAList, StSpawnReply] = Sequence,
912
913    %% Spawn request...
914     {Ref,
915      {send,
916       {0,1},
917       Self,Node,
918       ReqMessage},
919      _} = StSpawnRequest,
920
921    spawn_request = element(1, ReqMessage),
922    ReqId = element(2, ReqMessage),
923
924    {Ref,
925     {send,
926      {0,2},
927      Self,Node,
928      _ArgList},
929     _} = StAList,
930
931    %% Spawn reply...
932    ReplyMessage = {SpawnReplyTag,ReqId,error,badopt},
933    {Ref,
934     {'receive',
935      {1,2},
936      Node,Self,
937      ReplyMessage},
938     _} = StSpawnReply,
939
940    SequenceNode = lists:keysort(3,stop_tracer(Node, 2)),
941    io:format("SequenceNode: ~p~n", [SequenceNode]),
942    [StSpawnRequestNode, StSpawnReplyNode] = SequenceNode,
943
944    %% Spawn request...
945     {Ref,
946      {'receive',
947       {0,1},
948       Self,Node,
949       ReqMessage},
950      _} = StSpawnRequestNode,
951
952    %% Spawn reply...
953    {Ref,
954     {send,
955      {1,2},
956      Node,Self,
957      {spawn_reply, ReqId, error, badopt}},
958     _} = StSpawnReplyNode,
959
960    stop_node(Node),
961
962    ok.
963
964
965%% Send trace messages to a port.
966port(Config) when is_list(Config) ->
967    lists:foreach(fun (TsType) -> do_port(TsType, Config) end,
968		  ?TIMESTAMP_MODES).
969
970do_port(TsType, Config) ->
971    io:format("Testing ~p~n",[TsType]),
972    Port = load_tracer(Config),
973    seq_trace:set_system_tracer(Port),
974
975    set_token_flags([print, TsType]),
976    Small = [small,term],
977    seq_trace:print(0, Small),
978    case get_port_message(Port) of
979	      {seq_trace,0,{print,_,_,[],Small}} when TsType == no_timestamp ->
980		  ok;
981	      {seq_trace,0,{print,_,_,[],Small},Ts0} when TsType /= no_timestamp ->
982		  check_ts(TsType, Ts0),
983		  ok;
984	      Other ->
985		  seq_trace:reset_trace(),
986		  ct:fail({unexpected,Other})
987	  end,
988    %% OTP-4218 Messages from ports should not affect seq trace token.
989    %%
990    %% Check if trace token still is active on this process after
991    %% the get_port_message/1 above that receives from a port.
992    OtherSmall = [other | Small],
993    seq_trace:print(0, OtherSmall),
994    seq_trace:reset_trace(),
995    case get_port_message(Port) of
996	      {seq_trace,0,{print,_,_,[],OtherSmall}} when TsType == no_timestamp ->
997		  ok;
998	      {seq_trace,0,{print,_,_,[],OtherSmall}, Ts1} when TsType /= no_timestamp ->
999		  check_ts(TsType, Ts1),
1000		  ok;
1001	      Other1 ->
1002		  ct:fail({unexpected,Other1})
1003	  end,
1004
1005
1006    seq_trace:set_token(print, true),
1007    Huge = huge_data(),
1008    seq_trace:print(0, Huge),
1009    seq_trace:reset_trace(),
1010    case get_port_message(Port) of
1011	      {seq_trace,0,{print,_,_,[],Huge}} ->
1012		  ok;
1013	      Other2 ->
1014		  ct:fail({unexpected,Other2})
1015	  end,
1016    unlink(Port),
1017    exit(Port,kill),
1018    ok.
1019
1020get_port_message(Port) ->
1021    receive
1022	{Port,{data,Bin}} when is_binary(Bin) ->
1023	    binary_to_term(Bin);
1024	Other ->
1025	    ct:fail({unexpected,Other})
1026    after 5000 ->
1027	    ct:fail(timeout)
1028    end.
1029
1030
1031%% OTP-15849 ERL-700
1032%% Verify changing label on existing token when it resides on old heap.
1033%% Bug caused faulty ref from old to new heap.
1034old_heap_token(Config) when is_list(Config) ->
1035    seq_trace:set_token(label, 1),
1036    erlang:garbage_collect(self(), [{type, minor}]),
1037    erlang:garbage_collect(self(), [{type, minor}]),
1038    %% Now token tuple should be on old-heap.
1039    %% Set a new non-literal label which should reside on new-heap.
1040    NewLabel = {self(), "new label"},
1041    1 = seq_trace:set_token(label, NewLabel),
1042
1043    %% If bug, we now have a ref from old to new heap. Yet another minor gc
1044    %% will make that a ref to deallocated memory.
1045    erlang:garbage_collect(self(), [{type, minor}]),
1046    {label,NewLabel} = seq_trace:get_token(label),
1047    ok.
1048
1049%% Verify changing label on existing token when it resides on mature heap.
1050%% Bug caused faulty ref from old to new heap.
1051mature_heap_token(Config) when is_list(Config) ->
1052
1053    seq_trace:set_token(label, 1),
1054    erlang:garbage_collect(self(), [{type, minor}]),
1055    %% Now token should be on mature heap
1056    %% Set a new non-literal label which should reside on new-heap.
1057    NewLabel = {self(), "new label"},
1058    seq_trace:set_token(label, NewLabel),
1059
1060    %% If bug, we now have a ref from mature to new heap. If we now GC
1061    %% twice the token will refer to deallocated memory.
1062    erlang:garbage_collect(self(), [{type, minor}]),
1063    erlang:garbage_collect(self(), [{type, minor}]),
1064    {label,NewLabel} = seq_trace:get_token(label),
1065    ok.
1066
1067
1068match_set_seq_token(doc) ->
1069    ["Tests that match spec function set_seq_token does not "
1070     "corrupt the heap"];
1071match_set_seq_token(Config) when is_list(Config) ->
1072    Parent = self(),
1073
1074    %% OTP-4222 Match spec 'set_seq_token' corrupts heap
1075    %%
1076    %% This test crashes the emulator if the bug in question is present,
1077    %% it is therefore done in a slave node.
1078    %%
1079    %% All the timeout stuff is here to get decent accuracy of the error
1080    %% return value, instead of just 'timeout'.
1081    %%
1082    {ok, Sandbox} = start_node(seq_trace_other, []),
1083    true = rpc:call(Sandbox, code, add_patha,
1084			  [filename:dirname(code:which(?MODULE))]),
1085    Lbl = 4711,
1086    %% Do the possibly crashing test
1087    P1 =
1088	spawn(
1089	  fun () ->
1090		  Parent ! {self(),
1091			    rpc:call(Sandbox,
1092				     ?MODULE, do_match_set_seq_token, [Lbl])}
1093	  end),
1094    %% Probe the node with a simple rpc request, to see if it is alive.
1095    P2 =
1096	spawn(
1097	  fun () ->
1098		  receive after 4000 -> ok end,
1099		  Parent ! {self(), rpc:call(Sandbox, erlang, abs, [-1])}
1100	  end),
1101    %% If the test node hangs completely, this timer expires.
1102    R3 = erlang:start_timer(8000, self(), void),
1103    %%
1104    {ok, Log} =
1105	receive
1106	    {P1, Result} ->
1107		exit(P2, done),
1108		erlang:cancel_timer(R3),
1109		Result;
1110	    {P2, 1} ->
1111		exit(P1, timeout),
1112		erlang:cancel_timer(R3),
1113		{error, "Test process hung"};
1114	    {timeout, R3, _} ->
1115		exit(P1, timeout),
1116		exit(P2, timeout),
1117		{error, "Test node hung"}
1118	end,
1119
1120    %% Sort the log on Pid, as events from different processes
1121    %% are not guaranteed to arrive in a certain order to the
1122    %% tracer
1123    SortedLog = lists:keysort(2, Log),
1124
1125    ok = check_match_set_seq_token_log(Lbl, SortedLog),
1126    %%
1127    stop_node(Sandbox),
1128    ok.
1129
1130%% OTP-4222 Match spec 'set_seq_token' corrupts heap
1131%%
1132%% The crashing test goes as follows:
1133%%
1134%% One trigger function calls match spec function {set_seq_token, _, _},
1135%% which when faulty corrupts the heap. It is assured that the process
1136%% in question has a big heap and recently garbage collected so there
1137%% will be room on the heap, which is necessary for the crash to happen.
1138%%
1139%% Then two processes bounces a few messages between each other, and if
1140%% the heap is crashed the emulator crashes, or the triggering process's
1141%% loop data gets corrupted so the loop never ends.
1142do_match_set_seq_token(Label) ->
1143    seq_trace:reset_trace(),
1144    Tr = transparent_tracer(),
1145    TrPid = Tr(pid),
1146    erlang:trace_pattern({?MODULE, '_', '_'},
1147			 [{'_',
1148			   [{is_seq_trace}],
1149			   [{message, {get_seq_token}}]}],
1150			 [local]),
1151    erlang:trace_pattern({?MODULE, countdown, 2},
1152			 [{'_',
1153			   [],
1154			   [{set_seq_token, label, Label},
1155			    {message, {get_seq_token}}]}],
1156			 [local]),
1157    erlang:trace(new, true, [call, {tracer, TrPid}]),
1158    Ref = make_ref(),
1159    Bounce = spawn(fun () -> bounce(Ref) end),
1160    Mref = erlang:monitor(process, Bounce),
1161    _Countdown = erlang:spawn_opt(?MODULE, countdown_start, [Bounce, Ref],
1162				 [{min_heap_size, 4192}]),
1163    receive
1164	{'DOWN', Mref, _, _, normal} ->
1165	    Result = Tr({stop, 0}),
1166	    seq_trace:reset_trace(),
1167	    erlang:trace(new, false, [call]),
1168	    Result;
1169	{'DOWN', Mref, _, _, Reason} ->
1170	    Tr({stop, 0}),
1171	    seq_trace:reset_trace(),
1172	    erlang:trace(new, false, [call]),
1173	    {error, Reason}
1174    end.
1175
1176check_match_set_seq_token_log(
1177  Label,
1178  [{trace,B,call,{?MODULE,bounce,   [Ref]},    {0,Label,2,B,1}},
1179   {trace,B,call,{?MODULE,bounce,   [Ref]},    {0,Label,4,B,3}},
1180   {trace,B,call,{?MODULE,bounce,   [Ref]},    {0,Label,6,B,5}},
1181   {trace,C,call,{?MODULE,countdown,[B,Ref]},  {0,Label,0,C,0}},
1182   {trace,C,call,{?MODULE,countdown,[B,Ref,3]},{0,Label,0,C,0}},
1183   {trace,C,call,{?MODULE,countdown,[B,Ref,2]},{0,Label,2,B,1}},
1184   {trace,C,call,{?MODULE,countdown,[B,Ref,1]},{0,Label,4,B,3}},
1185   {trace,C,call,{?MODULE,countdown,[B,Ref,0]},{0,Label,6,B,5}}
1186  ]) ->
1187    ok;
1188check_match_set_seq_token_log(_Label, Log) ->
1189    {error, Log}.
1190
1191countdown_start(Bounce, Ref) ->
1192    %% This gc and the increased heap size of this process ensures that
1193    %% the match spec executed for countdown/2 has got heap space for
1194    %% the trace token, so the heap gets trashed according to OTP-4222.
1195    erlang:garbage_collect(),
1196    countdown(Bounce, Ref).
1197
1198countdown(Bounce, Ref) ->
1199    countdown(Bounce, Ref, 3).
1200
1201countdown(Bounce, Ref, 0) ->
1202    Bounce ! Ref;
1203countdown(Bounce, Ref, Cnt) ->
1204    Tag = make_ref(),
1205    Bounce ! {Ref, self(), {Tag, Cnt}},
1206    receive {Tag, Cnt} -> countdown(Bounce, Ref, Cnt-1) end.
1207
1208bounce(Ref) ->
1209    receive
1210	Ref ->
1211	    ok;
1212	{Ref, Dest, Msg} ->
1213	    Dest ! Msg,
1214	    bounce(Ref)
1215    end.
1216
1217
1218
1219gc_seq_token(doc) ->
1220    ["Tests that a seq_trace token on a message in the inqueue ",
1221     "can be garbage collected."];
1222gc_seq_token(Config) when is_list(Config) ->
1223    Parent = self(),
1224
1225    %% OTP-4555 Seq trace token causes free mem read in gc
1226    %%
1227    %% This test crashes the emulator if the bug in question is present,
1228    %% it is therefore done in a slave node.
1229    %%
1230    %% All the timeout stuff is here to get decent accuracy of the error
1231    %% return value, instead of just 'timeout'.
1232    %%
1233    {ok, Sandbox} = start_node(seq_trace_other, []),
1234    true = rpc:call(Sandbox, code, add_patha,
1235			  [filename:dirname(code:which(?MODULE))]),
1236    Label = 4711,
1237    %% Do the possibly crashing test
1238    P1 =
1239	spawn(
1240	  fun () ->
1241 		  Parent ! {self(),
1242			    rpc:call(Sandbox,
1243				     ?MODULE, do_gc_seq_token, [Label])}
1244	  end),
1245    %% Probe the node with a simple rpc request, to see if it is alive.
1246    P2 =
1247	spawn(
1248	  fun () ->
1249		  receive after 4000 -> ok end,
1250		  Parent ! {self(), rpc:call(Sandbox, erlang, abs, [-1])}
1251	  end),
1252    %% If the test node hangs completely, this timer expires.
1253    R3 = erlang:start_timer(8000, self(), void),
1254    %%
1255    ok =
1256	receive
1257	    {P1, Result} ->
1258		exit(P2, done),
1259		erlang:cancel_timer(R3),
1260		Result;
1261	    {P2, 1} ->
1262		exit(P1, timeout),
1263		erlang:cancel_timer(R3),
1264		{error, "Test process hung"};
1265	    {timeout, R3, _} ->
1266		exit(P1, timeout),
1267		exit(P2, timeout),
1268		{error, "Test node hung"}
1269	end,
1270    %%
1271    stop_node(Sandbox),
1272    ok.
1273
1274do_gc_seq_token(Label) ->
1275    Parent = self(),
1276    Comment =
1277	{"OTP-4555 Seq trace token causes free mem read in gc\n"
1278	 "\n"
1279	 "The crashing test goes as follows:\n"
1280	 "\n"
1281	 "Put a message with seq_trace token in the inqueue,\n"
1282	 "Grow the process heap big enough to become mmap'ed\n"
1283	 "and force a garbage collection using large terms\n"
1284	 "to get a test_heap instruction with a big size value.\n"
1285	 "Then try to trick the heap into shrinking.\n"
1286	 "\n"
1287	 "All this to make the GC move the heap between memory blocks.\n"},
1288    seq_trace:reset_trace(),
1289    Child = spawn_link(
1290	      fun() ->
1291		      receive {Parent, no_seq_trace_token} -> ok end,
1292		      do_grow(Comment, 256*1024, []),
1293		      do_shrink(10),
1294		      receive {Parent, seq_trace_token} -> ok end,
1295		      Parent ! {self(), {token, seq_trace:get_token(label)}}
1296	      end),
1297    seq_trace:set_token(label, Label),
1298    Child ! {Parent, seq_trace_token},
1299    seq_trace:set_token([]),
1300    Child ! {Parent, no_seq_trace_token},
1301    receive
1302	{Child, {token, {label, Label}}} ->
1303	    ok;
1304	{Child, {token, Other}} ->
1305	    {error, Other}
1306    end.
1307
1308do_grow(_, 0, Acc) ->
1309    Acc;
1310do_grow(E, N, Acc) ->
1311    do_grow(E, N-1, [E | Acc]).
1312
1313do_shrink(0) ->
1314    ok;
1315do_shrink(N) ->
1316    erlang:garbage_collect(),
1317    do_shrink(N-1).
1318
1319%% Test that messages from a port does not clear the token
1320port_clean_token(Config) when is_list(Config) ->
1321    seq_trace:reset_trace(),
1322    Label = make_ref(),
1323    seq_trace:set_token(label, Label),
1324    {label,Label} = seq_trace:get_token(label),
1325
1326    %% Create a port and get messages from it
1327    %% We use os:cmd as a convenience as it does
1328    %% open_port, port_command, port_close and receives replies.
1329    %% Maybe it is not ideal to rely on the internal implementation
1330    %% of os:cmd but it will have to do.
1331    os:cmd("ls"),
1332
1333    %% Make sure that the seq_trace token is still there
1334    {label,Label} = seq_trace:get_token(label),
1335
1336    ok.
1337
1338
1339%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1340%% Internal help functions
1341%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1342
1343%% Call trace targets
1344
1345call_tracee_1(X) ->
1346    X.
1347
1348call_tracee_2(X) ->
1349    X.
1350
1351
1352transparent_tracer() ->
1353    Ref = make_ref(),
1354    Loop =
1355	fun(Fun, Log, LN) ->
1356		receive
1357		    {stop, MinLN, Ref, From} when LN >= MinLN ->
1358			From ! {log, Ref, lists:reverse(Log)};
1359		    Entry when is_tuple(Entry) == false; element(1, Entry) /= stop ->
1360			Fun(Fun, [Entry | Log], LN+1)
1361		end
1362	end,
1363    Self = self(),
1364    Pid =
1365	spawn(fun() ->
1366		      seq_trace:set_system_tracer(self()),
1367		      Self ! {started, Ref},
1368		      Loop(Loop, [], 0)
1369	      end),
1370    receive {started, Ref} -> ok end,
1371    fun(pid) ->
1372	    Pid;
1373       ({stop, N}) when is_integer(N), N >= 0 ->
1374	    Mref = erlang:monitor(process, Pid),
1375	    receive
1376		{'DOWN', Mref, _, _, _} ->
1377		    {error, not_started}
1378	    after 0 ->
1379		    DeliverRef = erlang:trace_delivered(all),
1380		    receive
1381			{trace_delivered,_,DeliverRef} -> ok
1382		    end,
1383		    Pid ! {stop, N, Ref, self()},
1384		    receive {'DOWN', Mref, _, _, _} -> ok end,
1385		    receive {log, Ref, Log} ->
1386			    {ok, Log}
1387		    end
1388	    end
1389    end.
1390
1391n_time_receiver(0) ->
1392    ok;
1393n_time_receiver(N) ->
1394    receive _Term -> n_time_receiver(N-1)
1395    end.
1396
1397one_time_receiver() ->
1398    receive _Term -> ok
1399    end.
1400
1401one_time_receiver(exit) ->
1402    receive Term ->
1403	    exit({exit, Term})
1404    end.
1405
1406simple_tracer(Data, DN) ->
1407    receive
1408	{seq_trace,Label,Info,Ts} ->
1409	    simple_tracer([{Label,Info,Ts}|Data], DN+1);
1410	{seq_trace,Label,Info} ->
1411	    simple_tracer([{Label,Info, no_timestamp}|Data], DN+1);
1412	{stop,N,From} when DN >= N ->
1413	    From ! {tracerlog,lists:reverse(Data)}
1414    end.
1415
1416stop_tracer(N) when is_integer(N) ->
1417    stop_tracer(node(), N).
1418
1419stop_tracer(Node, N) when is_integer(N) ->
1420    case rpc:call(Node,erlang,whereis,[seq_trace_SUITE_tracer]) of
1421        Pid when is_pid(Pid) ->
1422            unlink(Pid),
1423            Mon = erlang:monitor(process, Pid),
1424            Pid ! {stop,N,self()},
1425            receive
1426                {'DOWN', Mon, process, Pid, noproc} ->
1427                    {error, not_started};
1428                {'DOWN', Mon, process, Pid, Reason} ->
1429                    {error, Reason};
1430                {tracerlog,Data} ->
1431                    erlang:demonitor(Mon, [flush]),
1432                    Data
1433            after 5000 ->
1434                    erlang:demonitor(Mon, [flush]),
1435                    {error,timeout}
1436            end;
1437        _ ->
1438            {error, not_started}
1439    end.
1440
1441start_tracer() ->
1442    start_tracer(node()).
1443
1444start_tracer(Node) ->
1445    Me = self(),
1446    Ref = make_ref(),
1447    Pid = spawn_link(Node,
1448                     fun () ->
1449                             Self = self(),
1450                             stop_tracer(0),
1451                             register(seq_trace_SUITE_tracer,Self),
1452                             seq_trace:set_system_tracer(Self),
1453                             Self = seq_trace:get_system_tracer(),
1454                             Me ! Ref,
1455                             simple_tracer([], 0)
1456                     end),
1457    receive
1458        Ref ->
1459            unlink(Pid),
1460            Pid
1461    end.
1462
1463set_token_flags([]) ->
1464    ok;
1465set_token_flags([no_timestamp|Flags]) ->
1466    seq_trace:set_token(timestamp, false),
1467    seq_trace:set_token(monotonic_timestamp, false),
1468    seq_trace:set_token(strict_monotonic_timestamp, false),
1469    set_token_flags(Flags);
1470set_token_flags([Flag|Flags]) ->
1471    seq_trace:set_token(Flag, true),
1472    set_token_flags(Flags).
1473
1474start_spawn_tracer(TraceFlags) ->
1475
1476    %% Disable old trace flags
1477    erlang:trace(self(), false, spawn_trace_flags()),
1478
1479    Me = self(),
1480    Ref = make_ref(),
1481    Pid = spawn_link(
1482            fun () ->
1483                    register(spawn_tracer, self()),
1484                    Me ! Ref,
1485                    (fun F(Data) ->
1486                             receive
1487                                 {get, N, StopRef, Pid} when N =< length(Data) ->
1488                                     Pid ! {lists:reverse(Data), StopRef};
1489                                 M when element(1,M) =:= trace ->
1490                                     F([M|Data])
1491                             end
1492                    end)([])
1493            end),
1494    receive
1495        Ref ->
1496            erlang:trace(self(),true,[{tracer,Pid}, procs | TraceFlags])
1497    end.
1498
1499stop_spawn_tracer(N) ->
1500    Ref = make_ref(),
1501    spawn_tracer ! {get, N, Ref, self()},
1502    receive
1503        {Data, Ref} ->
1504            Data
1505    end.
1506
1507spawn_trace_flags() ->
1508    [set_on_spawn, set_on_link, set_on_spawn,
1509     set_on_first_link, set_on_first_spawn].
1510
1511combinations(Flags) ->
1512    %% Do a bit of sofs magic to create a list of lists with
1513    %% all the combinations of all the flags above
1514    Set = sofs:from_term(Flags),
1515    Product = sofs:product(list_to_tuple(lists:duplicate(length(Flags),Set))),
1516    Combinations = [lists:usort(tuple_to_list(T)) || T <- sofs:to_external(Product)],
1517    [[] | lists:usort(Combinations)].
1518
1519check_ts(no_timestamp, Ts) ->
1520    try
1521	no_timestamp = Ts
1522    catch
1523	_ : _ ->
1524	    ct:fail({unexpected_timestamp, Ts})
1525    end,
1526    ok;
1527check_ts(timestamp, Ts) ->
1528    try
1529	{Ms,S,Us} = Ts,
1530	true = is_integer(Ms),
1531	true = is_integer(S),
1532	true = is_integer(Us)
1533    catch
1534	_ : _ ->
1535	    ct:fail({unexpected_timestamp, Ts})
1536    end,
1537    ok;
1538check_ts(monotonic_timestamp, Ts) ->
1539    try
1540	true = is_integer(Ts)
1541    catch
1542	_ : _ ->
1543	    ct:fail({unexpected_timestamp, Ts})
1544    end,
1545    ok;
1546check_ts(strict_monotonic_timestamp, Ts) ->
1547    try
1548	{MT, UMI} = Ts,
1549	true = is_integer(MT),
1550	true = is_integer(UMI)
1551    catch
1552	_ : _ ->
1553	    ct:fail({unexpected_timestamp, Ts})
1554    end,
1555    ok.
1556
1557start_node(Name, Param) ->
1558    test_server:start_node(Name, peer, [{args, Param}]).
1559
1560stop_node(Node) ->
1561    test_server:stop_node(Node).
1562
1563load_tracer(Config) ->
1564    Path = proplists:get_value(data_dir, Config),
1565    ok = erl_ddll:load_driver(Path, echo_drv),
1566    open_port({spawn,echo_drv}, [eof,binary]).
1567
1568huge_data() -> huge_data(16384).
1569huge_data(0) -> [];
1570huge_data(N) when N rem 2 == 0 ->
1571    P = huge_data(N div 2),
1572    [P|P];
1573huge_data(N) ->
1574    P = huge_data(N div 2),
1575    [16#1234566,P|P].
1576