1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2012-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(ts_benchmark).
21
22-include_lib("common_test/include/ct_event.hrl").
23-include_lib("kernel/include/file.hrl").
24-include("ts.hrl").
25
26-export([benchmarks/0,
27	 run/3]).
28
29%% gen_event callbacks
30-export([init/1, handle_event/2]).
31
32benchmarks() ->
33    {ok, Cwd} = file:get_cwd(),
34    ts_lib:specialized_specs(Cwd,"bench").
35
36run(Specs, Opts, Vars) ->
37    {ok, Cwd} = file:get_cwd(),
38    {{YY,MM,DD},{HH,Mi,SS}} = calendar:local_time(),
39    BName = lists:concat([YY,"_",MM,"_",DD,"T",HH,"_",Mi,"_",SS]),
40    BDir = filename:join([Cwd,BName]),
41    file:make_dir(BDir),
42    [ts_run:run(atom_to_list(Spec),
43		[{spec, [atom_to_list(Spec)++"_bench.spec"]}],
44		[{event_handler, {ts_benchmark, [Spec,BDir]}}|Opts],Vars)
45     || Spec <- Specs],
46    file:delete(filename:join(Cwd,"latest_benchmark")),
47    {ok,D} = file:open(filename:join(Cwd,"latest_benchmark"),[write]),
48    io:format(D,"~ts", [BDir]),
49    file:close(D).
50
51
52%%%===================================================================
53%%% gen_event callbacks
54%%%===================================================================
55
56-record(state, { spec, suite, tc, stats_dir}).
57
58init([Spec,Dir]) ->
59    {ok, #state{ spec = Spec, stats_dir = Dir }}.
60
61handle_event(#event{name = tc_start, data = {Suite,Tc}}, State) ->
62    {ok,State#state{ suite = Suite, tc = Tc}};
63handle_event(#event{name = benchmark_data, data = Data}, State) ->
64    Spec = proplists:get_value(application, Data, State#state.spec),
65    Suite = proplists:get_value(suite, Data, State#state.suite),
66    Tc = proplists:get_value(name, Data, State#state.tc),
67    Value = proplists:get_value(value, Data),
68    {ok, D} = file:open(filename:join(
69			  [State#state.stats_dir,
70			   lists:concat([e(Spec),"-",e(Suite),"-",
71					 e(Tc),".ebench"])]),
72			[append]),
73    io:format(D, "~p~n",[Value]),
74    file:close(D),
75    {ok, State};
76handle_event(_Event, State) ->
77    {ok, State}.
78
79
80e(Atom) when is_atom(Atom) ->
81    Atom;
82e(Str) when is_list(Str) ->
83    lists:map(fun($/) ->
84		      $\\;
85		 (C) ->
86		      C
87	      end,Str).
88