1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2018-2019. 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(socket_test_evaluator).
22
23%% Evaluator control functions
24-export([
25         start/3,
26         await_finish/1
27        ]).
28
29%% Functions used by evaluators to interact with eachother
30-export([
31         %% Announce functions
32         %% (Send an announcement from one evaluator to another)
33         announce_start/1,     announce_start/2,
34         announce_continue/2,  announce_continue/3,
35         announce_ready/2,     announce_ready/3,
36         announce_terminate/1,
37
38         %% Await functions
39         %% (Wait for an announcement from another evaluator)
40         await_start/0,        await_start/1,
41         await_continue/3,     await_continue/4,
42         await_ready/3,        await_ready/4,
43         await_terminate/2,    await_terminate/3,
44         await_termination/1,  await_termination/2
45        ]).
46
47%% Utility functions
48-export([
49         iprint/2, % Info  printouts
50         eprint/2  % Error printouts
51        ]).
52
53-export_type([
54              ev/0,
55              initial_evaluator_state/0,
56              evaluator_state/0,
57              command_fun/0,
58              command/0
59             ]).
60
61
62-include("socket_test_evaluator.hrl").
63
64-type ev() :: #ev{}.
65-type initial_evaluator_state() :: map().
66-type evaluator_state() :: term().
67-type command_fun() ::
68        fun((State :: evaluator_state()) -> ok) |
69        fun((State :: evaluator_state()) -> {ok, evaluator_state()}) |
70        fun((State :: evaluator_state()) -> {error, term()}).
71
72-type command() :: #{desc  := string(),
73                     cmd   := command_fun()}.
74
75
76%% ============================================================================
77
78-define(LIB,                    socket_test_lib).
79-define(LOGGER,                 socket_test_logger).
80
81-define(EXTRA_NOTHING,          '$nothing').
82-define(ANNOUNCEMENT_START,     '$start').
83-define(ANNOUNCEMENT_READY,     '$ready').
84-define(ANNOUNCEMENT_CONTINUE,  '$continue').
85-define(ANNOUNCEMENT_TERMINATE, '$terminate').
86
87-define(START_NAME_NONE,        '$no-name').
88-define(START_SLOGAN,           ?ANNOUNCEMENT_START).
89-define(TERMINATE_SLOGAN,       ?ANNOUNCEMENT_TERMINATE).
90
91
92%% ============================================================================
93
94-spec start(Name, Seq, Init) -> ev() when
95      Name :: string(),
96      Seq  :: [command()],
97      Init :: initial_evaluator_state().
98
99start(Name, Seq, InitState)
100  when is_list(Name) andalso is_list(Seq) andalso (Seq =/= []) ->
101    %% Make sure 'parent' is not already used
102    case maps:find(parent, InitState) of
103        {ok, _} ->
104            erlang:error({already_used, parent});
105        error ->
106            InitState2 = InitState#{parent => self()},
107            Pid = erlang:spawn_link(
108                    fun() -> init(Name, Seq, InitState2) end),
109            %% MRef = erlang:monitor(process, Pid),
110            #ev{name = Name, pid = Pid}%, mref = MRef}
111    end.
112
113init(Name, Seq, Init) ->
114    put(sname, Name),
115    process_flag(trap_exit, true),
116    loop(1, Seq, Init).
117
118loop(_ID, [], FinalState) ->
119    exit(FinalState);
120loop(ID, [#{desc := Desc,
121            cmd  := Cmd}|Cmds], State) when is_function(Cmd, 1) ->
122    iprint("evaluate command ~2w: ~s", [ID, Desc]),
123    try Cmd(State) of
124        ok ->
125            loop(ID + 1, Cmds, State);
126        {ok, NewState} ->
127            loop(ID + 1, Cmds, NewState);
128        {skip, Reason} ->
129            ?SEV_IPRINT("command ~w skip: "
130                        "~n   ~p", [ID, Reason]),
131            exit({skip, Reason});
132        {error, Reason} ->
133            ?SEV_EPRINT("command ~w failed: "
134                        "~n   ~p", [ID, Reason]),
135            exit({command_failed, ID, Reason, State})
136    catch
137        C:{skip, command} = E:_ when ((C =:= throw) orelse (C =:= exit)) ->
138            %% Secondary skip
139            exit(E);
140        C:{skip, R} = E:_ when ((C =:= throw) orelse (C =:= exit)) ->
141            ?SEV_IPRINT("command ~w skip catched(~w): "
142                        "~n   Reason: ~p", [ID, C, R]),
143            exit(E);
144        C:E:S ->
145            ?SEV_EPRINT("command ~w crashed: "
146                        "~n   Class:      ~p"
147                        "~n   Error:      ~p"
148                        "~n   Call Stack: ~p", [ID, C, E, S]),
149            exit({command_crashed, ID, {C,E,S}, State})
150    end.
151
152
153%% ============================================================================
154
155-spec await_finish(Evs) -> term() when
156      Evs :: [ev()].
157
158await_finish(Evs) ->
159    await_finish(Evs, [], []).
160
161await_finish([], _, []) ->
162    ok;
163await_finish([], _OK, Fails) ->
164    ?SEV_EPRINT("Fails: "
165		"~n   ~p", [Fails]),
166    Fails;
167await_finish(Evs, OK, Fails) ->
168    receive
169        %% Successfull termination of evaluator
170        {'DOWN', _MRef, process, Pid, normal} ->
171            {Evs2, OK2, Fails2} = await_finish_normal(Pid, Evs, OK, Fails),
172            await_finish(Evs2, OK2, Fails2);
173        {'EXIT', Pid, normal} ->
174            {Evs2, OK2, Fails2} = await_finish_normal(Pid, Evs, OK, Fails),
175            await_finish(Evs2, OK2, Fails2);
176
177        %% The evaluator can skip the test case:
178        {'DOWN', _MRef, process, Pid, {skip, Reason}} ->
179            %% ?SEV_IPRINT("await_finish -> skip (down) received: "
180            %%             "~n   Pid:    ~p"
181            %%             "~n   Reason: ~p", [Pid, Reason]),
182            await_finish_skip(Pid, Reason, Evs, OK);
183        {'EXIT', Pid, {skip, Reason}} ->
184            %% ?SEV_IPRINT("await_finish -> skip (exit) received: "
185            %%             "~n   Pid:    ~p"
186            %%             "~n   Reason: ~p", [Pid, Reason]),
187            await_finish_skip(Pid, Reason, Evs, OK);
188
189        %% Evaluator failed
190        {'DOWN', _MRef, process, Pid, Reason} ->
191            %% ?SEV_IPRINT("await_finish -> fail (down) received: "
192            %%             "~n   Pid:    ~p"
193            %%             "~n   Reason: ~p", [Pid, Reason]),
194            {Evs2, OK2, Fails2} =
195                await_finish_fail(Pid, Reason, Evs, OK, Fails),
196            await_finish(Evs2, OK2, Fails2);
197        {'EXIT', Pid, Reason} ->
198            %% ?SEV_IPRINT("await_finish -> fail (exit) received: "
199            %%             "~n   Pid:    ~p"
200            %%             "~n   Reason: ~p", [Pid, Reason]),
201            {Evs2, OK2, Fails2} =
202                await_finish_fail(Pid, Reason, Evs, OK, Fails),
203            await_finish(Evs2, OK2, Fails2)
204    end.
205
206
207await_finish_normal(Pid, Evs, OK, Fails) ->
208    case lists:keysearch(Pid, #ev.pid, Evs) of
209        {value, #ev{name = Name}} ->
210            iprint("evaluator '~s' (~p) success", [Name, Pid]),
211            NewEvs = lists:keydelete(Pid, #ev.pid, Evs),
212            {NewEvs, [Pid|OK], Fails};
213        false ->
214            case lists:member(Pid, OK) of
215                true ->
216                    ok;
217                false ->
218                    iprint("unknown process ~p died (normal)", [Pid]),
219                    ok
220            end,
221            {Evs, OK, Fails}
222    end.
223
224await_finish_skip(Pid, Reason, Evs, OK) ->
225    Evs2 =
226        case lists:keysearch(Pid, #ev.pid, Evs) of
227            {value, #ev{name = Name}} ->
228                ?SEV_IPRINT("evaluator '~s' (~p) issued SKIP: "
229                            "~n   ~p", [Name, Pid, Reason]),
230                lists:keydelete(Pid, #ev.pid, Evs);
231            false ->
232                case lists:member(Pid, OK) of
233                    true ->
234                        ?SEV_IPRINT("already terminated (ok) process ~p skip"
235                                    "~n   ~p", [Pid]),
236                        ok;
237                    false ->
238                        ?SEV_IPRINT("unknown process ~p issued SKIP: "
239                                    "~n   ~p", [Pid, Reason]),
240                        iprint("unknown process ~p issued SKIP: "
241                               "~n   ~p", [Pid, Reason])
242                end,
243                Evs
244        end,
245    await_evs_terminated(Evs2),
246    ?LIB:skip(Reason).
247
248await_evs_terminated(Evs) ->
249    Instructions =
250        [
251         %% Just wait for the evaluators to die on their own
252         {fun() -> ?SEV_IPRINT("await (no action) evs termination") end,
253          fun(_) -> ok end},
254
255         %% Send them a skip message, causing the evaluators to
256         %% die with a skip reason.
257         {fun() -> ?SEV_IPRINT("await (send skip message) evs termination") end,
258          fun(#ev{pid = Pid}) -> Pid ! skip end},
259
260         %% And if nothing else works, try to kill the remaining evaluators
261         {fun() -> ?SEV_IPRINT("await (issue exit kill) evs termination") end,
262          fun(#ev{pid = Pid}) -> exit(Pid, kill) end}],
263
264    await_evs_terminated(Evs, Instructions).
265
266await_evs_terminated([], _) ->
267    ok;
268await_evs_terminated(Evs, []) ->
269    {error, {failed_terminated, [P||#ev{pid=P} <- Evs]}};
270await_evs_terminated(Evs, [{Inform, Command}|Instructions]) ->
271    Inform(),
272    lists:foreach(Command, Evs),
273    RemEvs = await_evs_termination(Evs),
274    await_evs_terminated(RemEvs, Instructions).
275
276await_evs_termination(Evs) ->
277    await_evs_termination(Evs, 2000).
278
279await_evs_termination([], _Timeout) ->
280    [];
281await_evs_termination(Evs, Timeout) ->
282    T = t(),
283    receive
284        {'DOWN', _MRef, process, Pid, Reason} ->
285            ?SEV_IPRINT("await_evs_termination -> DOWN: "
286                        "~n   Pid:    ~p"
287                        "~n   Reason: ~p", [Pid, Reason]),
288            Evs2 = lists:keydelete(Pid, #ev.pid, Evs),
289            await_evs_termination(Evs2, tdiff(T, t()));
290        {'EXIT', Pid, Reason} ->
291            ?SEV_IPRINT("await_evs_termination -> EXIT: "
292                        "~n   Pid:    ~p"
293                        "~n   Reason: ~p", [Pid, Reason]),
294            Evs2 = lists:keydelete(Pid, #ev.pid, Evs),
295            await_evs_termination(Evs2, tdiff(T, t()))
296
297    after Timeout ->
298            Evs
299    end.
300
301
302await_finish_fail(Pid, Reason, Evs, OK, Fails) ->
303    case lists:keysearch(Pid, #ev.pid, Evs) of
304        {value, #ev{name = Name}} ->
305            iprint("evaluator '~s' (~p) failed", [Name, Pid]),
306            NewEvs = lists:keydelete(Pid, #ev.pid, Evs),
307            {NewEvs, OK, [{Pid, Reason}|Fails]};
308        false ->
309            case lists:member(Pid, OK) of
310                true ->
311                    ok;
312                false ->
313                    iprint("unknown process ~p died: "
314                           "~n   ~p", [Pid, Reason])
315            end,
316            {Evs, OK, Fails}
317    end.
318
319
320
321%% ============================================================================
322
323-spec announce_start(To) -> ok when
324      To :: pid().
325
326announce_start(To) ->
327    announce(To, ?ANNOUNCEMENT_START, ?START_SLOGAN).
328
329-spec announce_start(To, Extra) -> ok when
330      To    :: pid(),
331      Extra :: term().
332
333announce_start(To, Extra) ->
334    announce(To, ?ANNOUNCEMENT_START, ?START_SLOGAN, Extra).
335
336
337%% ============================================================================
338
339-spec announce_continue(To, Slogan) -> ok when
340      To     :: pid(),
341      Slogan :: atom().
342
343announce_continue(To, Slogan) ->
344    announce_continue(To, Slogan, ?EXTRA_NOTHING).
345
346-spec announce_continue(To, Slogan, Extra) -> ok when
347      To     :: pid(),
348      Slogan :: atom(),
349      Extra  :: term().
350
351announce_continue(To, Slogan, Extra) ->
352    announce(To, ?ANNOUNCEMENT_CONTINUE, Slogan, Extra).
353
354
355%% ============================================================================
356
357-spec announce_ready(To, Slogan) -> ok when
358      To     :: pid(),
359      Slogan :: atom().
360
361announce_ready(To, Slogan) ->
362    announce_ready(To, Slogan, ?EXTRA_NOTHING).
363
364-spec announce_ready(To, Slogan, Extra) -> ok when
365      To     :: pid(),
366      Slogan :: atom(),
367      Extra  :: term().
368
369announce_ready(To, Slogan, Extra) ->
370    announce(To, ?ANNOUNCEMENT_READY, Slogan, Extra).
371
372
373%% ============================================================================
374
375-spec announce_terminate(To) -> ok when
376      To     :: pid().
377
378announce_terminate(To) ->
379    announce(To, ?ANNOUNCEMENT_TERMINATE, ?TERMINATE_SLOGAN).
380
381
382%% ============================================================================
383
384-spec announce(To, Announcement, Slogan) -> ok when
385      To           :: pid(),
386      Announcement :: atom(),
387      Slogan       :: atom().
388
389announce(To, Announcement, Slogan) ->
390    announce(To, Announcement, Slogan, ?EXTRA_NOTHING).
391
392-spec announce(To, Announcement, Slogan, Extra) -> ok when
393      To           :: pid(),
394      Announcement :: atom(),
395      Slogan       :: atom(),
396      Extra        :: term().
397
398announce(To, Announcement, Slogan, Extra)
399  when is_pid(To) andalso
400       is_atom(Announcement) andalso
401       is_atom(Slogan) ->
402    %% iprint("announce -> entry with: "
403    %%        "~n   To:           ~p"
404    %%        "~n   Announcement: ~p"
405    %%        "~n   Slogan:       ~p"
406    %%        "~n   Extra:        ~p",
407    %%        [To, Announcement, Slogan, Extra]),
408    To ! {Announcement, self(), Slogan, Extra},
409    ok.
410
411
412
413%% ============================================================================
414
415-spec await_start() -> Pid | {Pid, Extra} when
416      Pid   :: pid(),
417      Extra :: term().
418
419await_start() ->
420    await_start(any).
421
422-spec await_start(Pid) -> Pid | {Pid, Extra} when
423      Pid   :: pid(),
424      Extra :: term().
425
426await_start(P) when is_pid(P) orelse (P =:= any) ->
427    case await(P, ?START_NAME_NONE, ?ANNOUNCEMENT_START, ?START_SLOGAN, []) of
428        {ok, Any} when is_pid(P) ->
429            Any;
430        {ok, Pid} when is_pid(Pid) andalso (P =:= any) ->
431            Pid;
432        {ok, {Pid, _} = OK} when is_pid(Pid) andalso (P =:= any) ->
433            OK
434    end.
435
436
437%% ============================================================================
438
439-spec await_continue(From, Name, Slogan) -> ok | {ok, Extra} | {error, Reason} when
440      From   :: pid(),
441      Name   :: atom(),
442      Slogan :: atom(),
443      Extra  :: term(),
444      Reason :: term().
445
446await_continue(From, Name, Slogan) ->
447    await_continue(From, Name, Slogan, []).
448
449-spec await_continue(From, Name, Slogan, OtherPids) ->
450                         ok | {ok, Extra} | {error, Reason} when
451      From      :: pid(),
452      Name      :: atom(),
453      Slogan    :: atom(),
454      OtherPids :: [{pid(), atom()}],
455      Extra     :: term(),
456      Reason    :: term().
457
458await_continue(From, Name, Slogan, OtherPids)
459  when is_pid(From) andalso
460       is_atom(Name) andalso
461       is_atom(Slogan) andalso
462       is_list(OtherPids) ->
463    await(From, Name, ?ANNOUNCEMENT_CONTINUE, Slogan, OtherPids).
464
465
466
467%% ============================================================================
468
469-spec await_ready(From, Name, Slogan) -> ok | {ok, Extra} | {error, Reason} when
470      From   :: pid(),
471      Name   :: atom(),
472      Slogan :: atom(),
473      Extra  :: term(),
474      Reason :: term().
475
476await_ready(From, Name, Slogan) ->
477    await_ready(From, Name, Slogan, []).
478
479-spec await_ready(From, Name, Slogan, OtherPids) ->
480                         ok | {ok, Extra} | {error, Reason} when
481      From      :: pid(),
482      Name      :: atom(),
483      Slogan    :: atom(),
484      OtherPids :: [{pid(), atom()}],
485      Extra     :: term(),
486      Reason    :: term().
487
488await_ready(From, Name, Slogan, OtherPids)
489  when is_pid(From) andalso
490       is_atom(Name) andalso
491       is_atom(Slogan) andalso
492       is_list(OtherPids) ->
493    await(From, Name, ?ANNOUNCEMENT_READY, Slogan, OtherPids).
494
495
496
497%% ============================================================================
498
499-spec await_terminate(Pid, Name) -> ok | {error, Reason} when
500      Pid    :: pid(),
501      Name   :: atom(),
502      Reason :: term().
503
504await_terminate(Pid, Name) when is_pid(Pid) andalso is_atom(Name) ->
505    await_terminate(Pid, Name, []).
506
507-spec await_terminate(Pid, Name, OtherPids) -> ok | {error, Reason} when
508      Pid       :: pid(),
509      Name      :: atom(),
510      OtherPids :: [{pid(), atom()}],
511      Reason    :: term().
512
513await_terminate(Pid, Name, OtherPids) ->
514    await(Pid, Name, ?ANNOUNCEMENT_TERMINATE, ?TERMINATE_SLOGAN, OtherPids).
515
516
517%% ============================================================================
518
519-spec await_termination(Pid) -> ok | {error, Reason} when
520      Pid    :: pid(),
521      Reason :: term().
522
523await_termination(Pid) when is_pid(Pid) ->
524    await_termination(Pid, any).
525
526-spec await_termination(Pid, ExpReason) -> ok | {error, Reason} when
527      Pid       :: pid(),
528      ExpReason :: term(),
529      Reason    :: term().
530
531await_termination(Pid, ExpReason) ->
532    receive
533        {'DOWN', _, process, Pid, _} when (ExpReason =:= any) ->
534            ok;
535        {'DOWN', _, process, Pid, Reason} when (ExpReason =:= Reason) ->
536            ok;
537        {'DOWN', _, process, Pid, Reason} ->
538            {error, {unexpected_reason, ExpReason, Reason}}
539    end.
540
541
542%% ============================================================================
543
544%% We expect a message (announcement) from Pid, but we also watch for DOWN from
545%% both Pid and OtherPids, in which case the test has failed!
546
547-spec await(ExpPid, Name, Announcement, Slogan, OtherPids) ->
548                   ok | {ok, Extra} | {error, Reason} when
549      ExpPid       :: any | pid(),
550      Name         :: atom(),
551      Announcement :: atom(),
552      Slogan       :: atom(),
553      OtherPids    :: [{pid(), atom()}],
554      Extra        :: term(),
555      Reason       :: term().
556
557await(ExpPid, Name, Announcement, Slogan, OtherPids)
558  when (is_pid(ExpPid) orelse (ExpPid =:= any)) andalso
559       is_atom(Name) andalso
560       is_atom(Announcement) andalso
561       is_atom(Slogan) andalso
562       is_list(OtherPids) ->
563    receive
564        skip ->
565            %% This means that another evaluator has issued a skip,
566            %% and we have been instructed to terminate as a result.
567            ?LIB:skip(command);
568        {Announcement, Pid, Slogan, ?EXTRA_NOTHING} when (ExpPid =:= any) ->
569            {ok, Pid};
570        {Announcement, Pid, Slogan, Extra} when (ExpPid =:= any) ->
571            {ok, {Pid, Extra}};
572        {Announcement, Pid, Slogan, ?EXTRA_NOTHING} when (Pid =:= ExpPid) ->
573            ok;
574        {Announcement, Pid, Slogan, Extra} when (Pid =:= ExpPid) ->
575            {ok, Extra};
576        {'DOWN', _, process, Pid, {skip, SkipReason}} when (Pid =:= ExpPid) ->
577            iprint("Unexpected SKIP from ~w (~p): "
578                   "~n   ~p", [Name, Pid, SkipReason]),
579            ?LIB:skip({Name, SkipReason});
580        {'DOWN', _, process, Pid, Reason} when (Pid =:= ExpPid) ->
581            eprint("Unexpected DOWN from ~w (~p): "
582                   "~n   ~p", [Name, Pid, Reason]),
583            {error, {unexpected_exit, Name, Reason}};
584        {'DOWN', _, process, OtherPid, Reason} ->
585            case check_down(OtherPid, Reason, OtherPids) of
586                ok ->
587                    iprint("DOWN from unknown process ~p: "
588                           "~n      ~p"
589                           "~n   when"
590                           "~n      OtherPids: "
591                           "~n         ~p", [OtherPid, Reason, OtherPids]),
592                    await(ExpPid, Name, Announcement, Slogan, OtherPids);
593                {error, _} = ERROR ->
594                    ERROR
595            end
596    after infinity -> % For easy debugging, just change to some valid time (5000)
597            iprint("await -> timeout for msg from ~p (~w): "
598                   "~n   Announcement: ~p"
599                   "~n   Slogan:       ~p"
600                   "~nwhen"
601                   "~n   Messages:     ~p",
602                   [ExpPid, Name, Announcement, Slogan, pi(messages)]),
603            await(ExpPid, Name, Announcement, Slogan, OtherPids)
604    end.
605
606pi(Item) ->
607    pi(self(), Item).
608
609pi(Pid, Item) ->
610    {Item, Info} = process_info(Pid, Item),
611    Info.
612
613check_down(Pid, DownReason, Pids) ->
614    case lists:keymember(Pid, 1, Pids) of
615        {value, {_, Name}} ->
616            eprint("Unexpected DOWN from ~w (~p): "
617                   "~n   ~p", [Name, Pid, DownReason]),
618            {error, {unexpected_exit, Name, DownReason}};
619        false ->
620            ok
621    end.
622
623
624%% ============================================================================
625
626f(F, A) ->
627    lists:flatten(io_lib:format(F, A)).
628
629
630iprint(F, A) ->
631    print("", F, A).
632
633eprint(F, A) ->
634    print("<ERROR> ", F, A).
635
636print(Prefix, F, A) ->
637    %% The two prints is to get the output both in the shell (for when
638    %% "personal" testing is going on) and in the logs.
639    IDStr =
640        case get(sname) of
641            undefined ->
642                %% This means its not an evaluator,
643                %% or a named process. Instead its
644                %% most likely the test case itself,
645                %% so skip the name and the pid.
646                "";
647            SName ->
648                f("[~s][~p]", [SName, self()])
649        end,
650    ?LOGGER:format("[~s]~s ~s" ++ F,
651                   [?LIB:formated_timestamp(), IDStr, Prefix | A]).
652
653
654%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
655
656t() ->
657    os:timestamp().
658
659
660tdiff({A1, B1, C1} = _T1x, {A2, B2, C2} = _T2x) ->
661    T1 = A1*1000000000+B1*1000+(C1 div 1000),
662    T2 = A2*1000000000+B2*1000+(C2 div 1000),
663    T2 - T1.
664
665