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