1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1998-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-module(trace_bif_SUITE).
22
23-include_lib("common_test/include/ct.hrl").
24
25-export([all/0, suite/0]).
26-export([trace_bif/1, trace_bif_timestamp/1, trace_on_and_off/1,
27	 trace_bif_local/1,
28	 trace_bif_timestamp_local/1, trace_bif_return/1,
29	 trace_info_old_code/1]).
30
31-export([bif_process/0]).
32
33suite() -> [{ct_hooks,[ts_install_cth]}].
34
35all() ->
36    [trace_bif, trace_bif_timestamp, trace_on_and_off,
37     trace_bif_local, trace_bif_timestamp_local,
38     trace_bif_return, trace_info_old_code].
39
40%% Tests switching tracing on and off.
41trace_on_and_off(Config) when is_list(Config) ->
42    Pid = spawn_link(?MODULE, bif_process, []),
43    Self = self(),
44    1 = erlang:trace(Pid, true, [call,timestamp]),
45    {flags, Flags} = erlang:trace_info(Pid,flags),
46    [call,timestamp] = lists:sort(Flags),
47    {tracer, Self} = erlang:trace_info(Pid,tracer),
48    1 = erlang:trace(Pid, false, [timestamp]),
49    {flags,[call]} =  erlang:trace_info(Pid,flags),
50    {tracer, Self} = erlang:trace_info(Pid,tracer),
51    1 = erlang:trace(Pid, false, [call]),
52    {flags,[]} =  erlang:trace_info(Pid,flags),
53    {tracer, []} = erlang:trace_info(Pid,tracer),
54    unlink(Pid),
55    exit(Pid,kill),
56    ok.
57
58%% Test tracing BIFs.
59trace_bif(Config) when is_list(Config) ->
60    do_trace_bif([]).
61
62%% Test tracing BIFs with local flag.
63trace_bif_local(Config) when is_list(Config) ->
64    do_trace_bif([local]).
65
66do_trace_bif(Flags) ->
67    Pid = spawn_link(?MODULE, bif_process, []),
68    1 = erlang:trace(Pid, true, [call]),
69    erlang:trace_pattern({erlang,'_','_'}, [], Flags),
70    Pid ! {do_bif, time, []},
71    receive_trace_msg({trace,Pid,call,{erlang,time, []}}),
72    Pid ! {do_bif, statistics, [runtime]},
73    receive_trace_msg({trace,Pid,call,
74                       {erlang,statistics, [runtime]}}),
75
76    Pid ! {do_time_bif},
77    receive_trace_msg({trace,Pid,call,
78                       {erlang,time, []}}),
79
80    Pid ! {do_statistics_bif},
81    receive_trace_msg({trace,Pid,call,
82                       {erlang,statistics, [runtime]}}),
83
84    1 = erlang:trace(Pid, false, [call]),
85    erlang:trace_pattern({erlang,'_','_'}, false, Flags),
86    unlink(Pid),
87    exit(Pid, die),
88    ok.
89
90%% Test tracing BIFs with timestamps.
91trace_bif_timestamp(Config) when is_list(Config) ->
92    do_trace_bif_timestamp([], timestamp, [timestamp]),
93    do_trace_bif_timestamp([], timestamp,
94                           [timestamp,
95                            monotonic_timestamp,
96                            strict_monotonic_timestamp]),
97    do_trace_bif_timestamp([], strict_monotonic_timestamp,
98                           [strict_monotonic_timestamp]),
99    do_trace_bif_timestamp([], strict_monotonic_timestamp,
100                           [monotonic_timestamp, strict_monotonic_timestamp]),
101    do_trace_bif_timestamp([], monotonic_timestamp, [monotonic_timestamp]).
102
103%% Test tracing BIFs with timestamps and local flag.
104trace_bif_timestamp_local(Config) when is_list(Config) ->
105    do_trace_bif_timestamp([local], timestamp, [timestamp]),
106    do_trace_bif_timestamp([local], timestamp,
107                           [timestamp,
108                            monotonic_timestamp,
109                            strict_monotonic_timestamp]),
110    do_trace_bif_timestamp([local], strict_monotonic_timestamp,
111                           [strict_monotonic_timestamp]),
112    do_trace_bif_timestamp([local], strict_monotonic_timestamp,
113                           [monotonic_timestamp, strict_monotonic_timestamp]),
114    do_trace_bif_timestamp([local], monotonic_timestamp, [monotonic_timestamp]).
115
116do_trace_bif_timestamp(Flags, TsType, TsFlags) ->
117    io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]),
118    Pid = spawn_link(?MODULE, bif_process, []),
119    1 = erlang:trace(Pid, true, [call]++TsFlags),
120    erlang:trace_pattern({erlang,'_','_'}, [], Flags),
121
122    Ts0 = make_ts(TsType),
123    Pid ! {do_bif, time, []},
124    Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}},
125                               Ts0,TsType),
126
127    Pid ! {do_bif, statistics, [runtime]},
128    Ts2 = receive_trace_msg_ts({trace_ts,Pid,call,
129                                {erlang,statistics, [runtime]}},
130                               Ts1, TsType),
131
132    Pid ! {do_time_bif},
133    Ts3 = receive_trace_msg_ts({trace_ts,Pid,call,
134                                {erlang,time, []}},
135                               Ts2, TsType),
136
137    Pid ! {do_statistics_bif},
138    Ts4 = receive_trace_msg_ts({trace_ts,Pid,call,
139                                {erlang,statistics, [runtime]}},
140                               Ts3, TsType),
141
142    check_ts(TsType, Ts4, make_ts(TsType)),
143
144    %% We should be able to turn off the timestamp.
145    1 = erlang:trace(Pid, false, TsFlags),
146
147    Pid ! {do_statistics_bif},
148    receive_trace_msg({trace,Pid,call,
149                       {erlang,statistics, [runtime]}}),
150
151    Pid ! {do_bif, statistics, [runtime]},
152    receive_trace_msg({trace,Pid,call,
153                       {erlang,statistics, [runtime]}}),
154
155    1 = erlang:trace(Pid, false, [call]),
156    erlang:trace_pattern({erlang,'_','_'}, false, Flags),
157
158    unlink(Pid),
159    exit(Pid, die),
160    ok.
161
162%% Test tracing BIF's with return/return_to trace.
163trace_bif_return(Config) when is_list(Config) ->
164    do_trace_bif_return(timestamp, [timestamp]),
165    do_trace_bif_return(timestamp,
166                        [timestamp,
167                         monotonic_timestamp,
168                         strict_monotonic_timestamp]),
169    do_trace_bif_return(strict_monotonic_timestamp,
170                        [strict_monotonic_timestamp]),
171    do_trace_bif_return(strict_monotonic_timestamp,
172                        [monotonic_timestamp, strict_monotonic_timestamp]),
173    do_trace_bif_return(monotonic_timestamp, [monotonic_timestamp]).
174
175do_trace_bif_return(TsType, TsFlags) ->
176    io:format("Testing with TsType=~p TsFlags=~p~n", [TsType, TsFlags]),
177    Pid = spawn_link(?MODULE, bif_process, []),
178    1 = erlang:trace(Pid, true, [call,return_to]++TsFlags),
179    erlang:trace_pattern({erlang,'_','_'}, [{'_',[],[{return_trace}]}],
180                         [local]),
181
182    Ts0 = make_ts(TsType),
183    Pid ! {do_bif, time, []},
184    Ts1 = receive_trace_msg_ts({trace_ts,Pid,call,{erlang,time,[]}},
185                               Ts0, TsType),
186    Ts2 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
187                                            {erlang,time,0}},
188                                           Ts1, TsType),
189    Ts3 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
190                                          {?MODULE, bif_process,0}},
191                                         Ts2, TsType),
192
193
194    Pid ! {do_bif, statistics, [runtime]},
195    Ts4 = receive_trace_msg_ts({trace_ts,Pid,call,
196                                {erlang,statistics, [runtime]}},
197                               Ts3, TsType),
198    Ts5 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
199                                            {erlang,statistics,1}},
200                                           Ts4, TsType),
201    Ts6 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
202                                          {?MODULE, bif_process,0}},
203                                         Ts5, TsType),
204
205
206    Pid ! {do_time_bif},
207    Ts7 = receive_trace_msg_ts({trace_ts,Pid,call,
208                                {erlang,time, []}},
209                               Ts6, TsType),
210    Ts8 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
211                                            {erlang,time,0}},
212                                           Ts7, TsType),
213    Ts9 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
214                                          {?MODULE, bif_process,0}},
215                                         Ts8, TsType),
216
217
218
219    Pid ! {do_statistics_bif},
220    Ts10 = receive_trace_msg_ts({trace_ts,Pid,call,
221                                 {erlang,statistics, [runtime]}},
222                                Ts9, TsType),
223    Ts11 = receive_trace_msg_ts_return_from({trace_ts,Pid,return_from,
224                                             {erlang,statistics,1}},
225                                            Ts10, TsType),
226    Ts12 = receive_trace_msg_ts_return_to({trace_ts,Pid,return_to,
227                                           {?MODULE, bif_process,0}},
228                                          Ts11, TsType),
229    check_ts(TsType, Ts12, make_ts(TsType)),
230    erlang:trace_pattern({erlang,'_','_'}, false, [local]),
231    ok.
232
233
234receive_trace_msg(Mess) ->
235    receive
236        Mess ->
237            ok;
238        Other ->
239            ct:fail("Expected: ~p,~nGot: ~p~n", [Mess, Other])
240    after 5000 ->
241              ct:fail("Expected: ~p,~nGot: timeout~n", [Mess])
242    end.
243
244receive_trace_msg_ts({trace_ts, Pid, call, {erlang,F,A}}, PrevTs, TsType) ->
245    receive
246        {trace_ts, Pid, call, {erlang, F, A}, Ts} = M ->
247            io:format("~p (PrevTs: ~p)~n",[M, PrevTs]),
248            check_ts(TsType, PrevTs, Ts),
249            Ts;
250        Other ->
251            ct:fail("Expected: {trace, ~p, call, {~p, ~p, ~p}, TimeStamp}},~n"
252                    "Got: ~p~n",
253                    [Pid, erlang, F, A, Other])
254    after 5000 ->
255              ct:fail("Got timeout~n", [])
256    end.
257
258receive_trace_msg_ts_return_from({trace_ts, Pid, return_from, {erlang,F,A}}, PrevTs, TsType) ->
259    receive
260        {trace_ts, Pid, return_from, {erlang, F, A}, _Value, Ts} = M ->
261            io:format("~p (PrevTs: ~p)~n",[M, PrevTs]),
262            check_ts(TsType, PrevTs, Ts),
263            Ts;
264        Other ->
265            ct:fail("Expected: {trace_ts, ~p, return_from, {~p, ~p, ~p}, Value, TimeStamp}},~n"
266                    "Got: ~p~n", [Pid, erlang, F, A, Other])
267    after 5000 ->
268              ct:fail("Got timeout~n", [])
269    end.
270
271receive_trace_msg_ts_return_to({trace_ts, Pid, return_to, {M,F,A}}, PrevTs, TsType) ->
272    receive
273        {trace_ts, Pid, return_to, {M, F, A}, Ts} = Msg ->
274            io:format("~p (PrevTs: ~p)~n",[Msg, PrevTs]),
275            check_ts(TsType, PrevTs, Ts),
276            Ts;
277        Other ->
278            ct:fail("Expected: {trace_ts, ~p, return_to, {~p, ~p, ~p}, TimeStamp}},~n"
279                    "Got: ~p~n", [Pid, M, F, A, Other])
280    after 5000 ->
281              ct:fail("Got timeout~n", [])
282    end.
283
284make_ts(timestamp) ->
285    erlang:now();
286make_ts(monotonic_timestamp) ->
287    erlang:monotonic_time(nanosecond);
288make_ts(strict_monotonic_timestamp) ->
289    MT = erlang:monotonic_time(nanosecond),
290    UMI = erlang:unique_integer([monotonic]),
291    {MT, UMI}.
292
293check_ts(timestamp, PrevTs, Ts) ->
294    {Ms, S, Us} = Ts,
295    true = is_integer(Ms),
296    true = is_integer(S),
297    true = is_integer(Us),
298    true = PrevTs < Ts,
299    Ts;
300check_ts(monotonic_timestamp, PrevTs, Ts) ->
301    true = is_integer(Ts),
302    true = PrevTs =< Ts,
303    Ts;
304check_ts(strict_monotonic_timestamp, PrevTs, Ts) ->
305    {MT, UMI} = Ts,
306    true = is_integer(MT),
307    true = is_integer(UMI),
308    true = PrevTs < Ts,
309    Ts.
310
311bif_process() ->
312    receive
313        {do_bif, Name, Args} ->
314            apply(erlang, Name, Args),
315            bif_process();
316        {do_time_bif} ->
317            %% Match the return value to ensure that the time() call
318            %% is not optimized away.
319            {_,_,_} = time(),
320            bif_process();
321        {do_statistics_bif} ->
322            statistics(runtime),
323            bif_process();
324        _Stuff ->
325            bif_process()
326    end.
327
328
329
330%% trace_info on deleted module (OTP-5057).
331trace_info_old_code(Config) when is_list(Config) ->
332    MFA = {M,F,0} = {test,foo,0},
333    Fname = atom_to_list(M)++".erl",
334    AbsForms =
335    [{attribute,a(1),module,M},                % -module(M).
336     {attribute,a(2),export,[{F,0}]},          % -export([F/0]).
337     {function,a(3),F,0,                       % F() ->
338      [{clause,a(4),[],[],[{atom,a(4),F}]}]}], %     F.
339    %%
340    {ok,M,Mbin} = compile:forms(AbsForms),
341    {module,M} = code:load_binary(M, Fname, Mbin),
342    true  = erlang:delete_module(M),
343    {traced,undefined} = erlang:trace_info(MFA, traced),
344    ok.
345
346a(L) ->
347    erl_anno:new(L).
348