File 0170-snmp-test-Improved-the-detection-of-system-events.patch of Package erlang

From 8cd31ce1a6fc834fee16ee009c999d2fb5922113 Mon Sep 17 00:00:00 2001
From: Micael Karlberg <bmk@erlang.org>
Date: Wed, 22 Jan 2020 13:51:19 +0100
Subject: [PATCH 10/10] [snmp|test] Improved the detection of system events

Improved the detection of system events when a tc fails.
Also introduce the pre and post fun's for the common
test case runner (tc_try).
The manager test suite has been converted to this.
---
 lib/snmp/test/snmp_manager_SUITE.erl | 201 +++++++++++++++++------------------
 lib/snmp/test/snmp_test_lib.erl      | 129 ++++++++++++++++------
 lib/snmp/test/snmp_test_lib.hrl      |  10 +-
 3 files changed, 204 insertions(+), 136 deletions(-)

diff --git a/lib/snmp/test/snmp_manager_SUITE.erl b/lib/snmp/test/snmp_manager_SUITE.erl
index 8d544c16de..bc7c5cd46d 100644
--- a/lib/snmp/test/snmp_manager_SUITE.erl
+++ b/lib/snmp/test/snmp_manager_SUITE.erl
@@ -1,7 +1,7 @@
 %% 
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2003-2019. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2020. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -337,8 +337,8 @@ ipv6_tests() ->
 
 init_per_suite(Config0) when is_list(Config0) ->
 
-    ?DBG("init_per_suite -> entry with"
-	 "~n   Config0: ~p", [Config0]),
+    p("init_per_suite -> entry with"
+      "~n      Config0: ~p", [Config0]),
 
     case ?LIB:init_per_suite(Config0) of
         {skip, _} = SKIP ->
@@ -346,6 +346,9 @@ init_per_suite(Config0) when is_list(Config0) ->
 
         Config1 ->
 
+            p("init_per_suite -> common init done"
+              "~n      Config1: ~p", [Config1]),
+
             %% Preferably this test SUITE should be divided into groups
             %% so that if crypto does not work only v3 tests that
             %% need crypto will be skipped, but as this is only a
@@ -788,14 +791,17 @@ do_simple_start_and_stop1(Config) ->
 
 simple_start_and_stop2(suite) -> [];
 simple_start_and_stop2(Config) when is_list(Config) ->
-    ?TC_TRY(simple_start_and_stop2,
-            fun() -> do_simple_start_and_stop2(Config) end).
-
-do_simple_start_and_stop2(Config) ->
+    Pre  = fun() ->
+                   ManagerNode = start_manager_node(), 
+                   [ManagerNode]
+           end,
+    Case = fun(State) -> do_simple_start_and_stop2(State, Config) end,
+    Post = fun([ManagerNode]) -> stop_node(ManagerNode) end,
+    ?TC_TRY(simple_start_and_stop2, Pre, Case, Post).
+
+do_simple_start_and_stop2([ManagerNode], Config) ->
     p("starting with Config: ~p~n", [Config]),
 
-    ManagerNode = start_manager_node(), 
-
     ConfDir = ?config(manager_conf_dir, Config),
     DbDir   = ?config(manager_db_dir, Config),
 
@@ -825,10 +831,6 @@ do_simple_start_and_stop2(Config) ->
 
     ?SLEEP(1000),
 
-    stop_node(ManagerNode),
-
-    ?SLEEP(1000),
-
     ok.
 
 
@@ -1405,14 +1407,17 @@ verify_info([{Key, SubKeys}|Keys], Info) ->
 
 register_user1(suite) -> [];
 register_user1(Config) when is_list(Config) ->
-    ?TC_TRY(register_user1,
-            fun() -> do_register_user1(Config) end).
-
-do_register_user1(Config) ->
+    Pre  = fun() ->
+                   ManagerNode = start_manager_node(), 
+                   [ManagerNode]
+           end,
+    Case = fun(State) -> do_register_user1(State, Config) end,
+    Post = fun([ManagerNode]) -> stop_node(ManagerNode) end,
+    ?TC_TRY(register_user1, Pre, Case, Post).
+
+do_register_user1([ManagerNode], Config) ->
     p("starting with Config: ~p~n", [Config]),
 
-    ManagerNode = start_manager_node(), 
-
     ConfDir = ?config(manager_conf_dir, Config),
     DbDir   = ?config(manager_db_dir, Config),
 
@@ -1478,10 +1483,6 @@ do_register_user1(Config) ->
 
     ?SLEEP(1000),
 
-    stop_node(ManagerNode),
-
-    ?SLEEP(1000),
-
     ok.
 
 verify_users([], []) ->
@@ -1504,14 +1505,17 @@ register_agent_old(doc) ->
 register_agent_old(suite) -> 
     [];
 register_agent_old(Config) when is_list(Config) ->
-    ?TC_TRY(register_agent_old,
-            fun() -> do_register_agent_old(Config) end).
-
-do_register_agent_old(Config) ->
+    Pre  = fun() ->
+                   ManagerNode = start_manager_node(), 
+                   [ManagerNode]
+           end,
+    Case = fun(State) -> do_register_agent_old(State, Config) end,
+    Post = fun([ManagerNode]) -> stop_node(ManagerNode) end,
+    ?TC_TRY(register_agent_old, Pre, Case, Post).
+
+do_register_agent_old([ManagerNode], Config) ->
     p("starting with Config: ~p~n", [Config]),
 
-    ManagerNode = start_manager_node(), 
-
     ConfDir = ?config(manager_conf_dir, Config),
     DbDir   = ?config(manager_db_dir, Config),
 
@@ -1618,10 +1622,6 @@ do_register_agent_old(Config) ->
 
     ?SLEEP(1000),
 
-    stop_node(ManagerNode),
-
-    ?SLEEP(1000),
-
     ok.
 
 
@@ -1632,19 +1632,21 @@ register_agent2(doc) ->
 register_agent2(suite) -> 
     [];
 register_agent2(Config) when is_list(Config) ->
-    ?TC_TRY(register_agent2,
-            fun() -> do_register_agent2(Config) end).
-
-do_register_agent2(Config) ->
+    Pre  = fun() ->
+                   ManagerNode = start_manager_node(), 
+                   [ManagerNode]
+           end,
+    Case = fun(State) -> do_register_agent2(State, Config) end,
+    Post = fun([ManagerNode]) -> stop_node(ManagerNode) end,
+    ?TC_TRY(register_agent2, Pre, Case, Post).
+
+do_register_agent2([ManagerNode], Config) ->
     p("starting with Config: ~p~n", [Config]),
 
-    ManagerNode = start_manager_node(), 
-
-    ConfDir = ?config(manager_conf_dir, Config),
-    DbDir   = ?config(manager_db_dir, Config),
+    ConfDir   = ?config(manager_conf_dir, Config),
+    DbDir     = ?config(manager_db_dir, Config),
     LocalHost = snmp_test_lib:localhost(), 
 
-
     write_manager_conf(ConfDir),
 
     Opts = [{server,     [{verbosity, trace}]},
@@ -1652,7 +1654,6 @@ do_register_agent2(Config) ->
 	    {note_store, [{verbosity, trace}]},
 	    {config, [{verbosity, trace}, {dir, ConfDir}, {db_dir, DbDir}]}],
 
-
     p("load snmp application"),
     ?line ok = load_snmp(ManagerNode),
 
@@ -1764,10 +1765,6 @@ do_register_agent2(Config) ->
 
     ?SLEEP(1000),
 
-    stop_node(ManagerNode),
-
-    ?SLEEP(1000),
-
     ok.
 
 
@@ -1779,14 +1776,17 @@ register_agent3(doc) ->
 register_agent3(suite) -> 
     [];
 register_agent3(Config) when is_list(Config) ->
-    ?TC_TRY(register_agent3,
-            fun() -> do_register_agent3(Config) end).
-
-do_register_agent3(Config) ->
+    Pre  = fun() ->
+                   ManagerNode = start_manager_node(), 
+                   [ManagerNode]
+           end,
+    Case = fun(State) -> do_register_agent3(State, Config) end,
+    Post = fun([ManagerNode]) -> stop_node(ManagerNode) end,
+    ?TC_TRY(register_agent3, Pre, Case, Post).
+
+do_register_agent3([ManagerNode], Config) ->
     p("starting with Config: ~p~n", [Config]),
 
-    ManagerNode = start_manager_node(), 
-
     ConfDir = ?config(manager_conf_dir, Config),
     DbDir   = ?config(manager_db_dir, Config),
     LocalHost = snmp_test_lib:localhost(), 
@@ -1915,10 +1915,6 @@ do_register_agent3(Config) ->
 
     ?SLEEP(1000),
 
-    stop_node(ManagerNode),
-
-    ?SLEEP(1000),
-
     ok.
 
 
@@ -1937,9 +1933,9 @@ do_simple_sync_get2(Config) ->
 		  mgr_user_sync_get(Node, TargetName, Oids) 
 	  end, 
     PostVerify = fun() -> ok end,
-    do_simple_sync_get2(Config, Get, PostVerify),
+    Res = do_simple_sync_get2(Config, Get, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 do_simple_sync_get2(Config, Get, PostVerify) ->
     p("starting with Config: ~p~n", [Config]),
@@ -2018,9 +2014,9 @@ do_simple_sync_get3(Config) ->
 			ok
 		end
 	end,
-    do_simple_sync_get2(Config, Get, PostVerify),
+    Res = do_simple_sync_get2(Config, Get, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 
 
@@ -2167,9 +2163,9 @@ do_simple_async_get3(Config) ->
     PostVerify = fun(ok)    -> receive Msg -> ok end;
 		    (Error) -> Error 
 		 end,
-    do_simple_async_sync_get2(Config, MgrNode, AgentNode, Get, PostVerify),
+    Res = do_simple_async_sync_get2(Config, MgrNode, AgentNode, Get, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 async_g_exec3(Node, TargetName, Oids, SendOpts) ->
     mgr_user_async_get2(Node, TargetName, Oids, SendOpts).
@@ -2225,9 +2221,9 @@ do_simple_sync_get_next2(Config) ->
 		      mgr_user_sync_get_next(Node, TargetName, Oids) 
 	      end,
     PostVerify = fun(Res) -> Res end,
-    do_simple_sync_get_next2(Config, GetNext, PostVerify),
+    Res = do_simple_sync_get_next2(Config, GetNext, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 
 do_simple_sync_get_next2(Config, GetNext, PostVerify) 
@@ -2388,9 +2384,9 @@ do_simple_async_get_next2(Config) ->
 		      async_gn_exec2(MgrNode, TargetName, Oids)
 	      end,
     PostVerify = fun(Res) -> Res end,
-    do_simple_async_get_next2(MgrNode, AgentNode, GetNext, PostVerify),
+    Res = do_simple_async_get_next2(MgrNode, AgentNode, GetNext, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 do_simple_async_get_next2(MgrNode, AgentNode, GetNext, PostVerify) 
   when is_function(GetNext, 1) andalso is_function(PostVerify, 1) ->
@@ -2532,9 +2528,9 @@ do_simple_async_get_next3(Config) ->
 		    (Error) -> Error 
 		 end,
 
-    do_simple_async_get_next2(MgrNode, AgentNode, GetNext, PostVerify),
+    Res = do_simple_async_get_next2(MgrNode, AgentNode, GetNext, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 async_gn_exec3(Node, TargetName, Oids, SendOpts) ->
     mgr_user_async_get_next2(Node, TargetName, Oids, SendOpts).
@@ -2570,9 +2566,9 @@ do_simple_sync_set2(Config) ->
 	  end,
     PostVerify = fun() -> ok end,
 
-    do_simple_sync_set2(Config, Set, PostVerify),
+    Res = do_simple_sync_set2(Config, Set, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 do_simple_sync_set2(Config, Set, PostVerify) 
   when is_function(Set, 3) andalso is_function(PostVerify, 0) ->
@@ -2651,9 +2647,9 @@ do_simple_sync_set3(Config) ->
 	  end,
     PostVerify = fun() -> receive Msg -> ok end end,
 
-    do_simple_sync_set2(Config, Set, PostVerify),
+    Res = do_simple_sync_set2(Config, Set, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 
 %%======================================================================
@@ -2715,9 +2711,9 @@ do_simple_async_set2(Config) ->
 	end,
     PostVerify = fun(Res) -> Res end,
 
-    do_simple_async_set2(MgrNode, AgentNode, Set, PostVerify),
+    Res = do_simple_async_set2(MgrNode, AgentNode, Set, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 do_simple_async_set2(MgrNode, AgentNode, Set, PostVerify) ->
     Requests = 
@@ -2816,9 +2812,9 @@ do_simple_async_set3(Config) ->
 		    (Res) -> Res 
 		 end,
 
-    do_simple_async_set2(MgrNode, AgentNode, Set, PostVerify),
+    Res = do_simple_async_set2(MgrNode, AgentNode, Set, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 async_s_exec3(Node, TargetName, VAVs, SendOpts) ->
     mgr_user_async_set2(Node, TargetName, VAVs, SendOpts).
@@ -2884,9 +2880,9 @@ do_simple_sync_get_bulk2(Config) ->
 	end,
     PostVerify = fun(Res) -> Res end,
 
-    do_simple_sync_get_bulk2(Config, MgrNode, AgentNode, GetBulk, PostVerify),
+    Res = do_simple_sync_get_bulk2(Config, MgrNode, AgentNode, GetBulk, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 do_simple_sync_get_bulk2(Config, MgrNode, AgentNode, GetBulk, PostVerify) ->
     %% -- 1 --
@@ -3053,9 +3049,9 @@ do_simple_sync_get_bulk3(Config) ->
 		    (Res) -> Res 
 		 end,
 
-    do_simple_sync_get_bulk2(Config, MgrNode, AgentNode, GetBulk, PostVerify),
+    Res = do_simple_sync_get_bulk2(Config, MgrNode, AgentNode, GetBulk, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 
 %%======================================================================
@@ -3085,9 +3081,9 @@ do_simple_async_get_bulk2(Config) ->
 	end,
     PostVerify = fun(Res) -> Res end,
 
-    do_simple_async_get_bulk2(MgrNode, AgentNode, GetBulk, PostVerify),
+    Res = do_simple_async_get_bulk2(MgrNode, AgentNode, GetBulk, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 do_simple_async_get_bulk2(MgrNode, AgentNode, GetBulk, PostVerify) ->
     %% We re-use the verification functions from the ssgb test-case
@@ -3258,9 +3254,9 @@ do_simple_async_get_bulk3(Config) ->
 		    (Res) -> Res 
 		 end,
 
-    do_simple_async_get_bulk2(MgrNode, AgentNode, GetBulk, PostVerify),
+    Res = do_simple_async_get_bulk2(MgrNode, AgentNode, GetBulk, PostVerify),
     display_log(Config),
-    ok.
+    Res.
 
 async_gb_exec3(Node, TargetName, {NR, MR, Oids}, SendOpts) ->
     mgr_user_async_get_bulk2(Node, TargetName, NR, MR, Oids, SendOpts).
@@ -3690,9 +3686,9 @@ do_trap1(Config) ->
 	 {5, "Manager and agent info after test completion", Cmd1}
 	],
 
-    command_handler(Commands),
+    Res = command_handler(Commands),
     display_log(Config),
-    ok.
+    Res.
 
     
 %%======================================================================
@@ -3885,9 +3881,9 @@ do_trap2(Config) ->
 	 {7, "Manager and agent info after test completion", Cmd1}
 	],
 
-    command_handler(Commands),
+    Res = command_handler(Commands),
     display_log(Config),
-    ok.
+    Res.
 
     
 %%======================================================================
@@ -4014,9 +4010,9 @@ do_inform1(Config) ->
 	 {6, "Manager and agent info after test completion", Cmd1}
 	],
 
-    command_handler(Commands),
+    Res = command_handler(Commands),
     display_log(Config),
-    ok.
+    Res.
 
 
 %%======================================================================
@@ -4188,9 +4184,9 @@ do_inform2(Config) ->
 	 {8, "Manager and agent info after test completion", Cmd1}
 	],
 
-    command_handler(Commands),
+    Res = command_handler(Commands),
     display_log(Config),
-    ok.
+    Res.
 
     
 %%======================================================================
@@ -4326,9 +4322,9 @@ do_inform3(Config) ->
 	 {9, "Manager and agent info after test completion", Cmd1}
 	],
 
-    command_handler(Commands),
+    Res = command_handler(Commands),
     display_log(Config),
-    ok.
+    Res.
 
     
 %%======================================================================
@@ -4446,9 +4442,9 @@ do_inform4(Config) ->
 	 {6, "Manager and agent info after test completion", Cmd1}
 	],
 
-    command_handler(Commands),
+    Res = command_handler(Commands),
     display_log(Config),
-    ok.
+    Res.
 
 
 %%======================================================================
@@ -4553,9 +4549,9 @@ do_inform_swarm(Config) ->
 	 {5, "Manager and agent info after test completion", Cmd1}
 	],
 
-    command_handler(Commands),
+    Res = command_handler(Commands),
     display_log(Config),
-    ok.
+    Res.
 
 
 inform_swarm_collector(N) ->
@@ -5931,9 +5927,12 @@ p(F) ->
 p(F, A) ->
     p(get(tname), F, A).
 
+p(undefined, F, A) ->
+    io:format("*** [~s] ***"
+              "~n   " ++ F ++ "~n", [formated_timestamp()|A]);
 p(TName, F, A) ->
-    io:format("*** [~w][~s] ***"
-              "~n   " ++ F ++ "~n", [TName, formated_timestamp()|A]).
+    io:format("*** [~s][~w] ***"
+              "~n   " ++ F ++ "~n", [formated_timestamp(),TName|A]).
 
 formated_timestamp() ->
     snmp_test_lib:formated_timestamp().
diff --git a/lib/snmp/test/snmp_test_lib.erl b/lib/snmp/test/snmp_test_lib.erl
index e7dc39b7bc..e8bcfa8a0e 100644
--- a/lib/snmp/test/snmp_test_lib.erl
+++ b/lib/snmp/test/snmp_test_lib.erl
@@ -1,7 +1,7 @@
 %% 
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2002-2019. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2020. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -23,7 +23,8 @@
 -include_lib("kernel/include/file.hrl").
 
 
--export([tc_try/2, tc_try/3]).
+-export([tc_try/2, tc_try/3,
+         tc_try/4, tc_try/5]).
 -export([hostname/0, hostname/1, localhost/0, localhost/1, os_type/0, sz/1,
 	 display_suite_info/1]).
 -export([non_pc_tc_maybe_skip/4,
@@ -56,45 +57,108 @@
 %% Run test-case
 %%
 
-%% *** tc_try/2,3 ***
-%% Case:      Basically the test case name
-%% TCCondFun: A fun that is evaluated before the actual test case
-%%            The point of this is that it can performs checks to
-%%            see if we shall run the test case at all.
-%%            For instance, the test case may only work in specific
-%%            conditions.
-%% FCFun:     The test case fun
-tc_try(Case, TCFun) ->
-    tc_try(Case, fun() -> ok end, TCFun).
-                        
-tc_try(Case, TCCondFun, TCFun)
-  when is_atom(Case) andalso 
-       is_function(TCCondFun, 0) andalso 
-       is_function(TCFun, 0) ->
+%% *** tc_try/2,3,4,5 ***
+%% Case:   Basically the test case name
+%% TCCond: A fun that is evaluated before the actual test case
+%%         The point of this is that it can performs checks to
+%%         see if we shall run the test case at all.
+%%         For instance, the test case may only work in specific
+%%         conditions.
+%% Pre:    A fun that is nominally part of the test case
+%%         but is an initiation that must be "undone". This is
+%%         done by the Post fun (regardless if the TC is successfull
+%%         or not). Example: Starts a couple of nodes,
+%% TC:     The test case fun
+%% Post:   A fun that undo what was done by the Pre fun.
+%%         Example: Stops the nodes created by the Pre function.
+tc_try(Case, TC) ->
+    tc_try(Case, fun() -> ok end, TC).
+
+tc_try(Case, TCCond, TC0) when is_function(TC0, 0) ->
+    Pre  = fun()  -> undefined end,
+    TC   = fun(_) -> TC0() end,
+    Post = fun(_) -> ok end,
+    tc_try(Case, TCCond, Pre, TC, Post).
+
+tc_try(Case, Pre, TC, Post)
+  when is_atom(Case) andalso
+       is_function(Pre, 0) andalso
+       is_function(TC, 1) andalso
+       is_function(Post, 1) ->
+    TCCond = fun() -> ok end,
+    tc_try(Case, TCCond, Pre, TC, Post).
+
+tc_try(Case, TCCond, Pre, TC, Post)
+  when is_atom(Case) andalso
+       is_function(TCCond, 0) andalso
+       is_function(Pre, 0) andalso
+       is_function(TC, 1) andalso
+       is_function(Post, 1) ->
     tc_begin(Case),
-    try TCCondFun() of
+    try TCCond() of
         ok ->
-            try 
-                begin
-                    TCFun(),
-                    sleep(seconds(1)),
-                    tc_end("ok")
-                end
+            try Pre() of
+                State ->
+                    try
+                        begin
+                            TC(State),
+                            sleep(seconds(1)),
+                            (catch Post(State)),
+                            tc_end("ok")
+                        end
+                    catch
+                        C:{skip, _} = SKIP when (C =:= throw) orelse
+                                                (C =:= exit) ->
+                            (catch Post(State)),
+                             tc_end( f("skipping(catched,~w,tc)", [C]) ),
+                            SKIP;
+                        C:E:S ->
+                            %% We always check the system events
+                            %% before we accept a failure.
+                            %% We do *not* run the Post here because it might
+                            %% generate sys events itself...
+                            case snmp_test_global_sys_monitor:events() of
+                                [] ->
+                                    (catch Post(State)),
+                                    tc_end( f("failed(catched,~w,tc)", [C]) ),
+                                    erlang:raise(C, E, S);
+                                SysEvs ->
+                                    tc_print("System Events received: "
+                                             "~n   ~p"
+                                             "~nwhen tc failed:"
+                                             "~n   C: ~p"
+                                             "~n   E: ~p"
+                                             "~n   S: ~p",
+                                             [SysEvs, C, E, S], "", ""),
+                                    (catch Post(State)),
+                                    tc_end( f("skipping(catched-sysevs,~w,tc)",
+                                              [C]) ),
+                                    SKIP = {skip, "TC failure with system events"},
+                                    SKIP
+                            end
+                    end
             catch
-                C:{skip, _} = SKIP when ((C =:= throw) orelse (C =:= exit)) ->
-                    tc_end( f("skipping(catched,~w,tc)", [C]) ),
+                C:{skip, _} = SKIP when (C =:= throw) orelse
+                                        (C =:= exit) ->
+                    tc_end( f("skipping(catched,~w,tc-pre)", [C]) ),
                     SKIP;
                 C:E:S ->
-                    %% We always check the system events before we accept a failure
+                    %% We always check the system events
+                    %% before we accept a failure
                     case snmp_test_global_sys_monitor:events() of
                         [] ->
-                            tc_end( f("failed(catched,~w,tc)", [C]) ),
+                            tc_end( f("failed(catched,~w,tc-pre)", [C]) ),
                             erlang:raise(C, E, S);
                         SysEvs ->
                             tc_print("System Events received: "
-                                     "~n   ~p", [SysEvs], "", ""),
-                            tc_end( f("skipping(catched-sysevs,~w,tc)", [C]) ),
-                            SKIP = {skip, "TC failure with system events"},
+                                     "~n   ~p"
+                                     "~nwhen tc-pre failed:"
+                                     "~n   C: ~p"
+                                     "~n   E: ~p"
+                                     "~n   S: ~p",
+                                     [SysEvs, C, E, S], "", ""),
+                            tc_end( f("skipping(catched-sysevs,~w,tc-pre)", [C]) ),
+                            SKIP = {skip, "TC-Pre failure with system events"},
                             SKIP
                     end
             end;
@@ -153,7 +217,8 @@ tc_print(F, A, Before, After) ->
     Name = tc_which_name(),
     FStr = f("*** [~s][~s][~p] " ++ F ++ "~n", 
              [formated_timestamp(),Name,self()|A]),
-    io:format(user, Before ++ FStr ++ After, []).
+    io:format(user, Before ++ FStr ++ After, []),
+    io:format(standard_io, Before ++ FStr ++ After, []).
 
 tc_which_name() ->
     case tc_get_name() of
diff --git a/lib/snmp/test/snmp_test_lib.hrl b/lib/snmp/test/snmp_test_lib.hrl
index e9f4fa5756..1e6e513d9d 100644
--- a/lib/snmp/test/snmp_test_lib.hrl
+++ b/lib/snmp/test/snmp_test_lib.hrl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2002-2019. All Rights Reserved.
+%% Copyright Ericsson AB 2002-2020. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -43,8 +43,12 @@
 
 
 %% - Test case macros - 
--define(TC_TRY(C, TC),            ?LIB:tc_try(C, TC)).
--define(TC_TRY(C, TCCond, TC),    ?LIB:tc_try(C, TCCond, TC)).
+
+-define(TC_TRY(C, TC),                     ?LIB:tc_try(C, TC)).
+-define(TC_TRY(C, TCCond, TC),             ?LIB:tc_try(C, TCCond, TC)).
+-define(TC_TRY(C, Pre, TC, Post),          ?LIB:tc_try(C, Pre, TC, Post)).
+-define(TC_TRY(C, TCCond, Pre, TC, Post),  ?LIB:tc_try(C, TCCond, Pre, TC, Post)).
+
 -define(OS_BASED_SKIP(Skippable), ?LIB:os_based_skip(Skippable)).
 -define(NON_PC_TC_MAYBE_SKIP(Config, Condition),
         ?LIB:non_pc_tc_maybe_skip(Config, Condition, ?MODULE, ?LINE)).
-- 
2.16.4

openSUSE Build Service is sponsored by