diff --git a/lib/common_test/doc/Makefile b/lib/common_test/doc/Makefile index 236b312853af..66722a56f7c5 100644 --- a/lib/common_test/doc/Makefile +++ b/lib/common_test/doc/Makefile @@ -26,7 +26,6 @@ include $(ERL_TOP)/make/$(TARGET)/otp.mk include ../vsn.mk VSN=$(COMMON_TEST_VSN) APPLICATION=common_test -EX_DOC_WARNINGS_AS_ERRORS=false # ---------------------------------------------------- # Release Target diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index f35b0c43e20b..31cd89ea56f5 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -20,8 +20,6 @@ -module(ct). -moduledoc """ -Main user interface for the Common Test framework. - Main user interface for the `Common Test` framework. This module implements the command-line interface for running tests and basic @@ -506,7 +504,7 @@ require(Name,Required) -> -doc(#{equiv => get_config(Required, undefined, [])}). -spec get_config(Required) -> Value when Required :: KeyOrName | {KeyOrName, SubKey} | {KeyOrName, SubKey, SubKey}, - KeyOrName :: atom(), + KeyOrName :: key_or_name(), SubKey :: atom(), Value :: term(). get_config(Required) -> @@ -515,7 +513,7 @@ get_config(Required) -> -doc(#{equiv => get_config(Required, Default, [])}). -spec get_config(Required, Default) -> Value when Required :: KeyOrName | {KeyOrName, SubKey} | {KeyOrName, SubKey, SubKey}, - KeyOrName :: atom(), + KeyOrName :: key_or_name(), SubKey :: atom(), Default :: term(), Value :: term(). @@ -574,7 +572,7 @@ See also [`ct:get_config/1`](`get_config/1`), """. -spec get_config(Required, Default, Opts) -> ValueOrElement when Required :: KeyOrName | {KeyOrName, SubKey} | {KeyOrName, SubKey, SubKey}, - KeyOrName :: atom(), + KeyOrName :: key_or_name(), SubKey :: atom(), Default :: term(), Opts :: [Opt], @@ -597,7 +595,7 @@ aliases. -doc(#{since => <<"OTP R14B">>}). -spec reload_config(Required) -> ValueOrElement | {error, Reason} when Required :: KeyOrName | {KeyOrName, SubKey} | {KeyOrName, SubKey, SubKey}, - KeyOrName :: atom(), + KeyOrName :: key_or_name(), SubKey :: atom(), ValueOrElement :: term(), Reason :: term(). @@ -661,7 +659,7 @@ escape_chars(Format, Args) -> {error,Reason} end. --doc(#{equiv => log(default, ?STD_IMPORTANCE, Format, [], [])}). +-doc "Equivalent to [`log(default, ?STD_IMPORTANCE, Format, [], [])`](`log/5`).". -spec log(Format) -> ok when Format :: string(). log(Format) -> @@ -750,7 +748,7 @@ printed with this function, unless the `esc_chars` option is used. log(Category,Importance,Format,Args,Opts) -> ct_logs:tc_log(Category,Importance,Format,Args,Opts). --doc(#{equiv => print(default, ?STD_IMPORTANCE, Format, [], [])}). +-doc "Equivalent to [`print(default, ?STD_IMPORTANCE, Format, [], [])`](`print/5`).". -spec print(Format) -> ok when Format :: string(). print(Format) -> @@ -835,7 +833,7 @@ the User's Guide. print(Category,Importance,Format,Args,Opts) -> ct_logs:tc_print(Category,Importance,Format,Args,Opts). --doc(#{equiv => pal(default, ?STD_IMPORTANCE, Format, [], [])}). +-doc "Equivalent to [`pal(default, ?STD_IMPORTANCE, Format, [])`](`pal/4`).". -spec pal(Format) -> ok when Format :: string(). pal(Format) -> diff --git a/lib/common_test/src/ct_cover.erl b/lib/common_test/src/ct_cover.erl index 738a86a7a5d6..d64e4c291b83 100644 --- a/lib/common_test/src/ct_cover.erl +++ b/lib/common_test/src/ct_cover.erl @@ -20,8 +20,6 @@ -module(ct_cover). -moduledoc """ -Common Test framework code coverage support module. - `Common Test` framework code coverage support module. This module exports help functions for performing code coverage analysis. diff --git a/lib/common_test/src/ct_ftp.erl b/lib/common_test/src/ct_ftp.erl index 36e05390a276..ec1fcc35333f 100644 --- a/lib/common_test/src/ct_ftp.erl +++ b/lib/common_test/src/ct_ftp.erl @@ -20,8 +20,6 @@ -module(ct_ftp). -moduledoc """ -FTP client module (based on the FTP application). - FTP client module (based on the `ftp` application). """. @@ -38,7 +36,7 @@ FTP client module (based on the `ftp` application). -define(DEFAULT_PORT,21). --doc "For `target_name`, see module `m:ct`.". +-doc "Reference to opened FTP connection associated to either a `handle` or `target_name`.". -type connection() :: handle() | ct:target_name(). -doc "Handle for a specific FTP connection, see module `m:ct`.". -type handle() :: ct:handle(). @@ -52,8 +50,6 @@ Opens an FTP connection and sends a file to the remote host. `LocalFile` and `RemoteFile` must be absolute paths. -For `target_name`, see module `m:ct`. - If the target host is a "special" node, the FTP address must be specified in the configuration file as follows: @@ -73,7 +69,7 @@ configuration file must also include the username and password (both strings): See also `ct:require/2`. """. -spec put(KeyOrName, LocalFile, RemoteFile) -> 'ok' | {'error', Reason} - when KeyOrName :: atom(), + when KeyOrName :: ct:key_or_name(), LocalFile :: file:filename(), RemoteFile :: file:filename(), Reason :: term(). @@ -88,12 +84,10 @@ Opens an FTP connection and fetches a file from the remote host. The configuration file must be as for [`ct_ftp:put/3`](`put/3`). -For `target_name`, see module `m:ct`. - See also `ct:require/2`. """. -spec get(KeyOrName, RemoteFile, LocalFile) -> 'ok' | {'error', Reason} - when KeyOrName :: atom(), + when KeyOrName :: ct:key_or_name(), RemoteFile :: file:filename(), LocalFile :: file:filename(), Reason :: term(). @@ -112,11 +106,9 @@ the target. A connection without an associated target name can only be closed with the handle value. For information on how to create a new `Name`, see `ct:require/2`. - -For `target_name`, see module `m:ct`. """. -spec open(KeyOrName) -> {'ok', Handle} | {'error', Reason} - when KeyOrName :: atom(), + when KeyOrName :: ct:key_or_name(), Handle :: handle(), Reason :: term(). open(KeyOrName) -> diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index a665d9f5538d..638f6d818bbd 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -126,7 +126,7 @@ That is: - If a test case is skipped, this function is called after [`post_end_per_testcase`](`c:post_end_per_testcase/5`). -If the skipped test case belongs to a test case group, the first argument is a +If the skipped test case belongs to a test case group, the second argument is a tuple `{FuncName,GroupName}`, otherwise only the function name. The data that comes with `Reason` follows the same format as events @@ -163,7 +163,7 @@ That is: - If a test case fails, this function is called after [`post_end_per_testcase`](`c:post_end_per_testcase/5`). -If the failed test case belongs to a test case group, the first argument is a +If the failed test case belongs to a test case group, the second argument is a tuple `{FuncName,GroupName}`, otherwise only the function name. The data that comes with `Reason` follows the same format as diff --git a/lib/common_test/src/ct_master.erl b/lib/common_test/src/ct_master.erl index 36d9924fdb30..271b834fc33e 100644 --- a/lib/common_test/src/ct_master.erl +++ b/lib/common_test/src/ct_master.erl @@ -20,8 +20,6 @@ -module(ct_master). -moduledoc """ -Distributed test execution control for Common Test. - Distributed test execution control for `Common Test`. This module exports functions for running `Common Test` nodes on multiple hosts @@ -43,6 +41,7 @@ in parallel. -include("ct_event.hrl"). -include("ct_util.hrl"). +-doc "Filename of test spec to be executed.". -type test_spec() :: file:name_all(). -record(state, {node_ctrl_pids=[], diff --git a/lib/common_test/src/ct_property_test.erl b/lib/common_test/src/ct_property_test.erl index 053fb5b7061d..e2c82c354cae 100644 --- a/lib/common_test/src/ct_property_test.erl +++ b/lib/common_test/src/ct_property_test.erl @@ -93,9 +93,17 @@ prop_ftp() -> ]). %% Type declarations +-type arguments() :: [term()]. +-type function_name() :: atom(). +-type symbolic_var() :: {'var', pos_integer()}. +-type symbolic_call() :: {'call', module(), function_name(), arguments()}. +-type symbolic_state() :: term(). -type dynamic_state() :: term(). --type command() :: term(). +-type set_command() :: {'set', symbolic_var(), symbolic_call()}. +-type init_command() :: {'init', symbolic_state()}. +-type command() :: set_command() | init_command(). -type command_list() :: [command()]. +-type parallel_testcase() :: {command_list(), [command_list()]}. -type history() :: [term()]. -type statem_result() :: 'ok' | term(). @@ -233,7 +241,7 @@ quickcheck(Property, Config) -> -doc(#{equiv => present_result(Module, Cmds, Triple, Config, []), since => <<"OTP 22.3">>}). -spec present_result(Module, Cmds, Triple, Config) -> boolean() when Module :: module(), - Cmds :: command() | command_list(), + Cmds :: command_list() | parallel_testcase(), Triple :: {H, Sf, Result}, H :: history(), Sf :: dynamic_state(), @@ -315,7 +323,7 @@ The default `StatisticsSpec` is: -doc(#{since => <<"OTP 22.3">>}). -spec present_result(Module, Cmds, Triple, Config, Options0) -> boolean() when Module :: module(), - Cmds :: command() | command_list(), + Cmds :: command_list() | parallel_testcase(), Triple :: {H, Sf, Result}, H :: history(), Sf :: dynamic_state(), @@ -361,6 +369,7 @@ print_frequency() -> print_frequency_ranges() -> print_frequency_ranges([{ngroups,10}]). +-doc false. print_frequency_ranges(Options0) -> fun([]) -> io_lib:format('Empty list!~n',[]); @@ -374,6 +383,45 @@ print_frequency_ranges(Options0) -> end end. +-doc """ +Returns a list of commands (function calls) generated in the `Cmnd` sequence, +without Module, Arguments and other details. + +For more information see: `present_result/5`. +""". +-doc #{since => "OTP @OTP-19148@"}. +-spec cmnd_names(Cs) -> Result when + Cs :: command_list() | parallel_testcase(), + Result :: [function_name()]. +cmnd_names(Cs) -> traverse_commands(fun cmnd_name/1, Cs). +cmnd_name(L) -> [F || {set,_Var,{call,_Mod,F,_As}} <- L]. + +-doc """ +Returns number of command calls in a test case. + +For more information see: `present_result/5`. +""". +-doc #{since => "OTP @OTP-19148@"}. +-spec num_calls(Cs) -> Result when + Cs :: command_list() | parallel_testcase(), + Result :: [non_neg_integer()]. +num_calls(Cs) -> traverse_commands(fun num_call/1, Cs). +num_call(L) -> [length(L)]. + +-doc """ +Returns a list with information about sequential and parallel parts. + +For more information see: `present_result/5`. +""". +-doc #{since => "OTP @OTP-19148@"}. +-spec sequential_parallel(Cs) -> Result when + Cs :: command_list() | parallel_testcase(), + Result :: [atom()]. +sequential_parallel(Cs) -> + traverse_commands(fun(L) -> dup_module(L, sequential) end, + fun(L) -> [dup_module(L1, mkmod("parallel",num(L1,L))) || L1<-L] end, + Cs). + %%%================================================================ %%% %%% Local functions @@ -483,19 +531,6 @@ do_present_result(Module, Cmds, H, Sf, Result, _Config, Options) -> Result == ok. % Proper dislikes non-boolean results while eqc treats non-true as false. %%%================================================================ --doc false. -cmnd_names(Cs) -> traverse_commands(fun cmnd_name/1, Cs). -cmnd_name(L) -> [F || {set,_Var,{call,_Mod,F,_As}} <- L]. - --doc false. -num_calls(Cs) -> traverse_commands(fun num_call/1, Cs). -num_call(L) -> [length(L)]. - --doc false. -sequential_parallel(Cs) -> - traverse_commands(fun(L) -> dup_module(L, sequential) end, - fun(L) -> [dup_module(L1, mkmod("parallel",num(L1,L))) || L1<-L] end, - Cs). dup_module(L, ModName) -> lists:duplicate(length(L), ModName). mkmod(PfxStr,N) -> list_to_atom(PfxStr++"_"++integer_to_list(N)). diff --git a/lib/common_test/src/ct_rpc.erl b/lib/common_test/src/ct_rpc.erl index 7ca5d9080c10..e381ecefb3ed 100644 --- a/lib/common_test/src/ct_rpc.erl +++ b/lib/common_test/src/ct_rpc.erl @@ -20,8 +20,6 @@ -module(ct_rpc). -moduledoc """ -Common Test specific layer on Erlang/OTP rpc. - `Common Test` specific layer on Erlang/OTP `rpc`. """. diff --git a/lib/common_test/src/ct_slave.erl b/lib/common_test/src/ct_slave.erl index 2235432d155a..c361bb90a233 100644 --- a/lib/common_test/src/ct_slave.erl +++ b/lib/common_test/src/ct_slave.erl @@ -25,9 +25,6 @@ %%---------------------------------------------------------------------- -module(ct_slave). -moduledoc """ -Common Test framework functions for starting and stopping nodes for Large-Scale -Testing. - `Common Test` framework functions for starting and stopping nodes for Large-Scale Testing. @@ -48,6 +45,7 @@ term in the Test Specification. kill_if_fail, erl_flags, env, ssh_port, ssh_opts, stop_timeout}). +-doc "Options used for starting `ct_slave` node.". -type start_options() :: [{'username', string()} | {'password', string()} | {'boot_timeout', non_neg_integer()} @@ -61,6 +59,7 @@ term in the Test Specification. | {'ssh_port', inet:port_number()} | {'ssh_opts', ssh:client_options()}]. +-doc "Options used for stopping `ct_slave` node.". -type stop_options() :: [{'stop_timeout', non_neg_integer()}]. -export_type([start_options/0, stop_options/0]). diff --git a/lib/common_test/src/ct_snmp.erl b/lib/common_test/src/ct_snmp.erl index 439c7aa6d0c9..a94f724439c1 100644 --- a/lib/common_test/src/ct_snmp.erl +++ b/lib/common_test/src/ct_snmp.erl @@ -20,8 +20,6 @@ -module(ct_snmp). -moduledoc """ -Common Test user interface module for the SNMP application. - `Common Test` user interface module for the `SNMP` application. The purpose of this module is to simplify SNMP configuration for the test case diff --git a/lib/common_test/src/ct_ssh.erl b/lib/common_test/src/ct_ssh.erl index fa031b943f8b..4ab1a08175c1 100644 --- a/lib/common_test/src/ct_ssh.erl +++ b/lib/common_test/src/ct_ssh.erl @@ -90,16 +90,20 @@ All time-out parameters in `ct_ssh` functions are values in milliseconds. -doc "Handle for a specific SSH/SFTP connection, see module `m:ct`.". -type handle() :: pid(). --doc "For `target_name`, see module `m:ct`.". +-doc "Reference to opened SSH/SFTP connection associated to either a `handle` or `target_name`.". -type connection() :: handle() | ct:target_name(). --doc "Connection type used for connect". +-doc "Connection type used for connect.". -type connection_type() :: 'host' | 'ssh' | 'sftp'. -doc """ The valid values are `0` ("normal") and `1` ("stderr"), see -[RFC 4254, Section 5.2](https://tools.ietf.org/html/rfc4254#page/8). +[RFC 4254, Section 5.2](https://tools.ietf.org/html/rfc4254#page-8). """. -type ssh_data_type_code() :: non_neg_integer(). --doc "For `ssh_channel_id`, see module `m:ssh`.". +-doc """ +Data type representing a channel inside a connection. + +"For `ssh_channel_id`, see module `m:ssh`.". +""". -type ssh_channel_id() :: non_neg_integer(). %%%----------------------------------------------------------------- @@ -107,7 +111,7 @@ The valid values are `0` ("normal") and `1` ("stderr"), see -doc(#{equiv => connect(KeyOrName, host, [])}). -spec connect(KeyOrName) -> {'ok', Handle} | {'error', Reason} - when KeyOrName :: atom(), + when KeyOrName :: ct:key_or_name(), Handle :: handle(), Reason :: term(). connect(KeyOrName) -> @@ -124,12 +128,12 @@ Equivalent to [`connect(KeyOrName, host, ExtraOpts)`](`connect/3`) if called with ExtraOpts being list. """. -spec connect(KeyOrName, ConnType) -> {'ok', Handle} | {'error', Reason} - when KeyOrName :: atom(), + when KeyOrName :: ct:key_or_name(), ConnType :: connection_type(), Handle :: handle(), Reason :: term(); (KeyOrName, ExtraOpts) -> {'ok', Handle} | {'error', Reason} - when KeyOrName :: atom(), + when KeyOrName :: ct:key_or_name(), ExtraOpts :: [ExtraOption], ExtraOption :: {'ssh', Address} | {'sftp', Address} | ssh:client_option() | ssh_sftp:sftp_option(), @@ -154,8 +158,6 @@ opened using the configuration data specified by `Key`). For information on how to create a new `Name`, see `ct:require/2`. -For `target_name`, see module `m:ct`. - `ConnType` always overrides the type specified in the address tuple in the configuration data (and in `ExtraOpts`). So it is possible to, for example, open an SFTP connection directly using data originally specifying an SSH connection. @@ -168,7 +170,7 @@ same key in the configuration data. For details on valid SSH options, see application [`SSH`](`e:ssh:index.html`). """. -spec connect(KeyOrName, ConnType, ExtraOpts) -> {'ok', Handle} | {'error', Reason} - when KeyOrName :: atom(), + when KeyOrName :: ct:key_or_name(), ConnType :: connection_type(), ExtraOpts :: [ExtraOption], ExtraOption :: {'ssh', Address} | {'sftp', Address} | ssh:client_option() @@ -629,7 +631,7 @@ shell(SSH, ChannelId) -> shell(SSH, ChannelId, ?DEFAULT_TIMEOUT). -doc """ -Requests that the user default shell (typically defined in `/etc/passwd` in Unix +Requests that the user's default shell (typically defined in `/etc/passwd` in Unix systems) is executed at the server end. """. -doc(#{since => <<"OTP 20.0">>}). diff --git a/lib/common_test/src/ct_suite.erl b/lib/common_test/src/ct_suite.erl index 28d4aa1a6f9a..1921a2d15765 100644 --- a/lib/common_test/src/ct_suite.erl +++ b/lib/common_test/src/ct_suite.erl @@ -1,7 +1,5 @@ -module(ct_suite). -moduledoc """ -\-behaviour(ct_suite). - The following section describes the mandatory and optional test suite functions that `Common Test` calls during test execution. For more details, see section [Writing Test Suites](write_test_chapter.md) in the User's Guide. @@ -96,7 +94,9 @@ The test suite information, as returned by [`Module:suite/0`](`c:suite/0`), -doc """ Returns the list of all test cases and test case groups in the test suite module -to be executed. This list also specifies the order the cases and groups are +to be executed. + +This list also specifies the order the cases and groups are executed by `Common Test`. A test case is represented by an atom, the name of the test case function, or a `testcase` tuple indicating that the test case shall be repeated. A test case group is represented by a `group` tuple, where @@ -163,12 +163,11 @@ Guide. [Info :: ct_info()]. -doc """ -OPTIONAL; if this function is defined, then -[`Module:end_per_suite/1`](`c:end_per_suite/1`) must also be defined. - This configuration function is called as the first function in the suite. It typically contains initializations that are common for all test cases in the -suite, and that must only be done once. Parameter `Config` is the configuration +suite, and that must only be done once. + +Parameter `Config` is the configuration data that can be modified. Whatever is returned from this function is specified as `Config` to all configuration functions and test cases in the suite. @@ -178,6 +177,9 @@ If `{skip, Reason}` is returned, all test cases in the suite are skipped and For information on `save_config` and `skip_and_save`, see section [Saving Configuration Data](dependencies_chapter.md#save_config) in the User's Guide. + +If this function is defined, then +[`Module:end_per_suite/1`](`c:end_per_suite/1`) must also be defined. """. -doc(#{title => <<"Callback Functions">>}). -callback init_per_suite(Config :: ct_config()) -> @@ -186,15 +188,15 @@ Guide. {skip_and_save, Reason :: term(), SaveConfig :: ct_config()}. -doc """ -OPTIONAL; if this function is defined, then -[`Module:init_per_suite/1`](`c:init_per_suite/1`) must also be defined. - This function is called as the last test case in the suite. It is meant to be used for cleaning up after [`Module:init_per_suite/1`](`c:init_per_suite/1`). For information on `save_config`, see section [Saving Configuration Data](dependencies_chapter.md#save_config) in the User's Guide. + +If this function is defined, then +[`Module:init_per_suite/1`](`c:init_per_suite/1`) must also be defined. """. -doc(#{title => <<"Callback Functions">>}). -callback end_per_suite(Config :: ct_config()) -> @@ -240,13 +242,11 @@ Guide. [Info :: ct_info()]. -doc """ -OPTIONAL; if this function is defined, then -[`Module:end_per_group/2`](`c:end_per_group/2`) must also be defined. - This configuration function is called before execution of a test case group. It typically contains initializations that are common for all test cases and -subgroups in the group, and that must only be performed once. `GroupName` is the -name of the group, as specified in the group definition (see +subgroups in the group, and that must only be performed once. + +`GroupName` is the name of the group, as specified in the group definition (see [`Module:groups/0`](`c:groups/0`)). Parameter `Config` is the configuration data that can be modified. The return value of this function is given as `Config` to all test cases and subgroups in the group. @@ -256,6 +256,9 @@ If `{skip, Reason}` is returned, all test cases in the group are skipped and For information about test case groups, see section [Test Case Groups](write_test_chapter.md#test_case_groups) in the User's Guide. + +If this function is defined, then +[`Module:end_per_group/2`](`c:end_per_group/2`) must also be defined. """. -doc(#{title => <<"Callback Functions">>}). -callback init_per_group(GroupName :: ct_groupname(), Config :: ct_config()) -> @@ -263,20 +266,20 @@ For information about test case groups, see section {skip, Reason :: term()}. -doc """ -OPTIONAL; if this function is defined, then -[`Module:init_per_group/2`](`c:init_per_group/2`) must also be defined. - This function is called after the execution of a test case group is finished. It -is meant to be used for cleaning up after -[`Module:init_per_group/2`](`c:init_per_group/2`). A status value for a nested -subgroup can be returned with `{return_group_result, Status}`. The status can be -retrieved in [`Module:end_per_group/2`](`c:end_per_group/2`) for the group on +is meant to be used for cleaning up after [`Module:init_per_group/2`](`c:init_per_group/2`). + +A status value for a nested subgroup can be returned with `{return_group_result, Status}`. +The status can be retrieved in [`Module:end_per_group/2`](`c:end_per_group/2`) for the group on the level above. The status is also used by `Common Test` for deciding if execution of a group is to proceed if property `sequence` or `repeat_until_*` is set. For details about test case groups, see section [Test Case Groups](write_test_chapter.md#test_case_groups) in the User's Guide. + +If this function is defined, then +[`Module:init_per_group/2`](`c:init_per_group/2`) must also be defined. """. -doc(#{title => <<"Callback Functions">>}). -callback end_per_group(GroupName :: ct_groupname(), Config :: ct_config()) -> @@ -284,17 +287,19 @@ For details about test case groups, see section {return_group_result, Status :: ct_status()}. -doc """ -OPTIONAL; if this function is defined, then -[`Module:end_per_testcase/2`](`c:end_per_testcase/2`) must also be defined. +This function is called before each test case. + +Argument `TestCase` is the test case name, and `Config` (list of key-value tuples) +is the configuration data that can be modified. The `NewConfig` list returned from this +function is given as `Config` to the test case. -This function is called before each test case. Argument `TestCase` is the test -case name, and `Config` (list of key-value tuples) is the configuration data -that can be modified. The `NewConfig` list returned from this function is given -as `Config` to the test case. If `{fail, Reason}` is returned, the test case is -marked as failed without being executed. +If `{fail, Reason}` is returned, the test case is marked as failed without being executed. If `{skip, Reason}` is returned, the test case is skipped and `Reason` is printed in the overview log for the suite. + +If this function is defined, then +[`Module:end_per_testcase/2`](`c:end_per_testcase/2`) must also be defined. """. -doc(#{title => <<"Callback Functions">>}). -callback init_per_testcase(TestCase :: ct_testname(), Config :: ct_config()) -> @@ -303,12 +308,10 @@ printed in the overview log for the suite. {skip, Reason :: term()}. -doc """ -OPTIONAL; if this function is defined, then -[`Module:init_per_testcase/2`](`c:init_per_testcase/2`) must also be defined. - This function is called after each test case, and can be used to clean up after -[`Module:init_per_testcase/2`](`c:init_per_testcase/2`) and the test case. Any -return value (besides `{fail, Reason}` and `{save_config, SaveConfig}`) is +[`Module:init_per_testcase/2`](`c:init_per_testcase/2`) and the test case. + +Any return value (besides `{fail, Reason}` and `{save_config, SaveConfig}`) is ignored. By returning `{fail, Reason}`, `TestCase` is marked as faulty (even though it was successful in the sense that it returned a value instead of terminating). @@ -316,6 +319,9 @@ terminating). For information on `save_config`, see section [Saving Configuration Data](dependencies_chapter.md#save_config) in the User's Guide. + +If this function is defined, then +[`Module:init_per_testcase/2`](`c:init_per_testcase/2`) must also be defined. """. -doc(#{title => <<"Callback Functions">>}). -callback end_per_testcase(TestCase :: ct_testname(), Config :: ct_config()) -> diff --git a/lib/common_test/src/ct_telnet.erl b/lib/common_test/src/ct_telnet.erl index b0e000f92be2..6523e1d4b9dc 100644 --- a/lib/common_test/src/ct_telnet.erl +++ b/lib/common_test/src/ct_telnet.erl @@ -20,8 +20,6 @@ -module(ct_telnet). -moduledoc """ -Common Test specific layer on top of Telnet client ct_telnet_client.erl - `Common Test` specific layer on top of Telnet client `ct_telnet_client.erl`. Use this module to set up Telnet connections, send commands, and perform string @@ -176,8 +174,9 @@ suite() -> -include("ct_util.hrl"). --doc "For `target_name()`, see module `m:ct`.". +-doc "Reference to opened Telnet connection associated to either a `handle` or `target_name`.". -type connection() :: handle() | {ct:target_name(), connection_type()} | ct:target_name(). +-doc "Telnet connection_type, valid values: 'telnet' | 'ts1' | 'ts2'.". -type connection_type() :: telnet | ts1 | ts2. -doc "Handle for a specific Telnet connection, see module `m:ct`.". -type handle() :: ct:handle(). @@ -187,7 +186,8 @@ Regular expression matching all possible prompts for a specific target type. STDLIB) must return a list with one single element. """. -type prompt_regexp() :: string(). --type send_option() :: {'newline', boolean() | string()}. +-doc "See `cmd/3` for explanation.". +-type newline_option() :: {'newline', boolean() | string()}. -export_type([connection/0, connection_type/0, handle/0, prompt_regexp/0]). -record(state,{host, @@ -237,7 +237,7 @@ open(Name,ConnType) -> -doc(#{equiv => open(KeyOrName, ConnType, TargetMod, KeyOrName)}). -spec open(KeyOrName, ConnType, TargetMod) -> {'ok', Handle} | {'error', Reason} - when KeyOrName :: atom(), + when KeyOrName :: ct:key_or_name(), ConnType :: connection_type(), TargetMod :: module(), Handle :: handle(), @@ -265,12 +265,10 @@ without an associated target name can only be closed with the `Handle` value. `connect(Ip, Port, KeepAlive, Extra)` and `get_prompt_regexp()` for the specified `TargetType` (for example, `unix_telnet`). -For `target_name()`, see module `m:ct`. - See also `ct:require/2`. """. -spec open(KeyOrName, ConnType, TargetMod, Extra) -> {'ok', Handle} | {'error', Reason} - when KeyOrName :: atom(), + when KeyOrName :: ct:key_or_name(), ConnType :: connection_type(), TargetMod :: module(), Extra :: term(), @@ -371,7 +369,7 @@ module. -spec cmd(Connection, Cmd, Opts) -> {'ok', Data} | {'error', Reason} when Connection :: connection(), Cmd :: iodata(), - Opts :: [{'timeout', Timeout} | send_option()] | Timeout, + Opts :: [{'timeout', Timeout} | newline_option()] | Timeout, Timeout :: integer(), Data :: string(), Reason :: term(). @@ -419,7 +417,7 @@ For details, see [`ct_telnet:cmd/3`](`cmd/3`). when Connection :: connection(), CmdFormat :: io:format(), Args :: [term()], - Opts :: [{'timeout', Timeout} | send_option()] | Timeout, + Opts :: [{'timeout', Timeout} | newline_option()] | Timeout, Timeout :: integer(), Data :: string(), Reason :: term(). @@ -475,7 +473,7 @@ The resulting output from the command can be read with -spec send(Connection, Cmd, Opts) -> 'ok' | {'error', Reason} when Connection :: connection(), Cmd :: iodata(), - Opts :: [send_option()], + Opts :: [newline_option()], Reason :: term(). send(Connection,Cmd,Opts) -> case check_send_opts(Opts) of @@ -526,7 +524,7 @@ For details, see [`ct_telnet:send/3`](`send/3`). when Connection :: connection(), CmdFormat :: io:format(), Args :: [term()], - Opts :: [send_option()], + Opts :: [newline_option()], Reason :: term(). sendf(Connection,CmdFormat,Args,Opts) when is_list(Args) -> Cmd = lists:flatten(io_lib:format(CmdFormat,Args)), diff --git a/lib/common_test/src/ct_testspec.erl b/lib/common_test/src/ct_testspec.erl index 6679036ef8c7..0af4fc844813 100644 --- a/lib/common_test/src/ct_testspec.erl +++ b/lib/common_test/src/ct_testspec.erl @@ -20,8 +20,6 @@ -module(ct_testspec). -moduledoc """ -Parsing of test specifications for Common Test. - Parsing of test specifications for `Common Test`. This module exports help functions for parsing of test specifications. diff --git a/lib/common_test/src/unix_telnet.erl b/lib/common_test/src/unix_telnet.erl index d5bcec211085..862f4e0505b2 100644 --- a/lib/common_test/src/unix_telnet.erl +++ b/lib/common_test/src/unix_telnet.erl @@ -20,8 +20,6 @@ -module(unix_telnet). -moduledoc """ -Callback module for ct_telnet, for connecting to a Telnet server on a UNIX host. - Callback module for `m:ct_telnet`, for connecting to a Telnet server on a UNIX host. @@ -79,11 +77,9 @@ Callback for `ct_telnet.erl`. Returns a suitable `regexp` string matching common prompts for users on Unix hosts. - -For `prompt_regexp()`, see `m:ct_telnet`. """. -spec get_prompt_regexp() -> Pattern - when Pattern :: string(). + when Pattern :: ct_telnet:prompt_regexp(). get_prompt_regexp() -> ?prx. @@ -93,8 +89,6 @@ Callback for `ct_telnet.erl`. [](){: #connect-6 } Setup Telnet connection to a Unix host. - -For `target_name()`, see `m:ct`. For `handle()`, see `m:ct_telnet`. """. -doc(#{since => <<"OTP 18.3.3">>}). -spec connect(ConnName, Ip, Port, Timeout, KeepAlive, TCPNoDelay, Extra) -> @@ -108,7 +102,7 @@ For `target_name()`, see `m:ct`. For `handle()`, see `m:ct_telnet`. Extra :: {Username, Password} | KeyOrName, Username :: iodata(), Password :: iodata(), - KeyOrName :: atom(), + KeyOrName :: ct:key_or_name(), Handle :: ct_telnet:handle(), Reason :: term(). connect(ConnName,Ip,Port,Timeout,KeepAlive,TCPNoDelay,Extra) -> diff --git a/lib/ssh/src/ssh_connection.erl b/lib/ssh/src/ssh_connection.erl index d96cc06639bc..8849f29575cc 100644 --- a/lib/ssh/src/ssh_connection.erl +++ b/lib/ssh/src/ssh_connection.erl @@ -127,7 +127,7 @@ If not, the `t:reason/0` indicates what went wrong: -doc """ The valid values are `0` ("normal") and `1` ("stderr"), see -[RFC 4254, Section 5.2](https://tools.ietf.org/html/rfc4254#page/8). +[RFC 4254, Section 5.2](https://tools.ietf.org/html/rfc4254#page-8). """. -type ssh_data_type_code() :: non_neg_integer(). % Only 0 and 1 are used