Skip to content

Commit

Permalink
Fix shell expand location below test
Browse files Browse the repository at this point in the history
Fix formatting
Remove empty -doc attributes
  • Loading branch information
frazze-jobb committed Feb 25, 2025
1 parent 8c187a8 commit 8c71b97
Show file tree
Hide file tree
Showing 6 changed files with 23 additions and 33 deletions.
9 changes: 0 additions & 9 deletions lib/common_test/src/ct_suite.erl
Original file line number Diff line number Diff line change
Expand Up @@ -112,7 +112,6 @@ If `{skip, Reason}` is returned, all test cases in the module are skipped and
For details on groups, see section
[Test Case Groups](write_test_chapter.md#test_case_groups) in the User's Guide.
""".
-doc(#{}).
-callback all() ->
[TestDef :: ct_test_def()] |
{skip, Reason :: term()}.
Expand All @@ -121,7 +120,6 @@ For details on groups, see section
Defines test case groups. For details, see section
[Test Case Groups](write_test_chapter.md#test_case_groups) in the User's Guide.
""".
-doc(#{}).
-callback groups() ->
[GroupDef :: ct_group_def()].

Expand Down Expand Up @@ -157,7 +155,6 @@ For details about the test suite information function, see section
[Test Suite Information Function](write_test_chapter.md#suite) in the User's
Guide.
""".
-doc(#{}).
-callback suite() ->
[Info :: ct_info()].

Expand All @@ -180,7 +177,6 @@ Guide.
If this function is defined, then
[`Module:end_per_suite/1`](`c:end_per_suite/1`) must also be defined.
""".
-doc(#{}).
-callback init_per_suite(Config :: ct_config()) ->
NewConfig :: ct_config() |
{skip, Reason :: term()} |
Expand All @@ -197,7 +193,6 @@ Guide.
If this function is defined, then
[`Module:init_per_suite/1`](`c:init_per_suite/1`) must also be defined.
""".
-doc(#{}).
-callback end_per_suite(Config :: ct_config()) ->
term() |
{save_config, SaveConfig :: ct_config()}.
Expand Down Expand Up @@ -259,7 +254,6 @@ For information about test case groups, see section
If this function is defined, then
[`Module:end_per_group/2`](`c:end_per_group/2`) must also be defined.
""".
-doc(#{}).
-callback init_per_group(GroupName :: ct_groupname(), Config :: ct_config()) ->
NewConfig :: ct_config() |
{skip, Reason :: term()}.
Expand All @@ -280,7 +274,6 @@ For details about test case groups, see section
If this function is defined, then
[`Module:init_per_group/2`](`c:init_per_group/2`) must also be defined.
""".
-doc(#{}).
-callback end_per_group(GroupName :: ct_groupname(), Config :: ct_config()) ->
term() |
{return_group_result, Status :: ct_status()}.
Expand All @@ -300,7 +293,6 @@ 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(#{}).
-callback init_per_testcase(TestCase :: ct_testname(), Config :: ct_config()) ->
NewConfig :: ct_config() |
{fail, Reason :: term()} |
Expand All @@ -322,7 +314,6 @@ Guide.
If this function is defined, then
[`Module:init_per_testcase/2`](`c:init_per_testcase/2`) must also be defined.
""".
-doc(#{}).
-callback end_per_testcase(TestCase :: ct_testname(), Config :: ct_config()) ->
term() |
{fail, Reason :: term()} |
Expand Down
14 changes: 7 additions & 7 deletions lib/kernel/test/interactive_shell_SUITE.erl
Original file line number Diff line number Diff line change
Expand Up @@ -1251,13 +1251,13 @@ shell_expand_location_below(Config) ->
send_tty(Term, "escript:"),
send_tty(Term, "\t"),
%% Cursor at correct place
check_location(Term, {-3, width("escript:")}),
check_location(Term, {-2, width("escript:")}),
%% Nothing after the start( completion
check_content(Term, "start\\($"),

%% Check that completion is cleared when we type
send_tty(Term, "s"),
check_location(Term, {-3, width("escript:s")}),
check_location(Term, {-2, width("escript:s")}),
check_content(Term, "escript:s$"),

%% Check that completion works when in the middle of a term
Expand All @@ -1267,7 +1267,7 @@ shell_expand_location_below(Config) ->
send_tty(Term, ", test_after]"),
[send_tty(Term, "Left") || _ <- ", test_after]"],
send_tty(Term, "\t"),
check_location(Term, {-3, width("[escript:s")}),
check_location(Term, {-2, width("[escript:s")}),
check_content(Term, "script_name\\([ ]+start\\($"),
send_tty(Term, "C-K"),

Expand All @@ -1291,7 +1291,7 @@ shell_expand_location_below(Config) ->
Rows1 = 48,
send_tty(Term, "long_module:" ++ FunctionName),
send_tty(Term, "\t"),
check_content(Term, "3> long_module:" ++ FunctionName ++ "\nfunctions(\n|.)*a_long_function_name0\\("),
check_content(Term, "3> long_module:" ++ FunctionName ++ "\nFunctions(\n|.)*a_long_function_name0\\("),

%% Check that correct text is printed below expansion
check_content(Term, io_lib:format("rows ~w to ~w of ~w",
Expand Down Expand Up @@ -1330,7 +1330,7 @@ shell_expand_location_below(Config) ->
tmux(["resize-window -t ", tty_name(Term), " -y ", integer_to_list(Row+10)]),
timer:sleep(1000), %% Sleep to make sure window has resized
send_tty(Term, "\t\t"),
check_content(Term, "3> long_module:" ++ FunctionName ++ "\nfunctions(\n|.)*a_long_function_name99\\($"),
check_content(Term, "3> long_module:" ++ FunctionName ++ "\nFunctions(\n|.)*a_long_function_name99\\($"),

%% Check that doing an expansion when cursor is in xnfix position works
send_tty(Term, "BSpace"),
Expand All @@ -1342,7 +1342,7 @@ shell_expand_location_below(Config) ->
send_tty(Term, "\t"),
check_location(Term, {-Rows + 2, -Col}),
send_tty(Term, "\t"),
check_content(Term, "3> a+, long_module:" ++ FunctionName ++ "\n\nfunctions(\n|.)*a_long_function_name0\\("),
check_content(Term, "3> a+, long_module:" ++ FunctionName ++ "\n\nFunctions(\n|.)*a_long_function_name0\\("),
check_location(Term, {-Rows + 2, -Col}),
send_tty(Term, "Down"),
check_location(Term, {-Rows + 2, -Col}),
Expand All @@ -1353,7 +1353,7 @@ shell_expand_location_below(Config) ->
send_tty(Term, lists:duplicate(Cols, "b")),
send_tty(Term, "End"),
send_tty(Term, "\t"),
check_content(Term, "3> b+\nb+a+, long_module:" ++ FunctionName ++ "\n\nfunctions(\n|.)*a_long_function_name0\\("),
check_content(Term, "3> b+\nb+a+, long_module:" ++ FunctionName ++ "\n\nFunctions(\n|.)*a_long_function_name0\\("),
check_location(Term, {-Rows + 3, -Col}),
send_tty(Term, "Down"),
check_location(Term, {-Rows + 3, -Col}),
Expand Down
1 change: 0 additions & 1 deletion lib/ssh/src/ssh_connection.erl
Original file line number Diff line number Diff line change
Expand Up @@ -112,7 +112,6 @@ If not, the `t:reason/0` indicates what went wrong:
""".
-type reason() :: closed | timeout .

-doc(#{}).
-type result() :: req_status() | {error, reason()} .

-doc """
Expand Down
1 change: 0 additions & 1 deletion lib/ssh/src/ssh_sftp.erl
Original file line number Diff line number Diff line change
Expand Up @@ -122,7 +122,6 @@ exit-signal. If that information is empty, the reason is the exit signal name.
The `t:tuple/0` reason are other errors like for example `{exit_status,1}`.
""".
-doc(#{}).
-type reason() :: atom() | string() | tuple() .

%%====================================================================
Expand Down
2 changes: 1 addition & 1 deletion lib/stdlib/src/edlin_expand.erl
Original file line number Diff line number Diff line change
Expand Up @@ -961,7 +961,7 @@ expand_name(ModStr, Type, Prefix, CompleteChar, FT) ->
Grouped = [{pp(G),{Name,Arity}} || {{Type1,Name,Arity},_,_,_,#{group := G}}<-Docs, Type1 =:= Type, lists:member({Name,Arity},Exports)],
Ungrouped = [{TypeStr,{Name,Arity}} || {{Type1,Name,Arity},_,_,_,MD}<-Docs, Type1 =:= Type, maps:is_key(group, MD) =:= false, lists:member({Name,Arity},Exports)];
type ->
Grouped = [{pp(G),{Name,Arity}} || {{Type1,Name,Arity},_,_,_,#{exported := true, group := G}}<-Docs, Type1 =:= Type, lists ],
Grouped = [{pp(G),{Name,Arity}} || {{Type1,Name,Arity},_,_,_,#{exported := true, group := G}}<-Docs, Type1 =:= Type],
Ungrouped = [{TypeStr,{Name,Arity}} || {{Type1,Name,Arity},_,_,_,#{exported := true}=MD}<-Docs, Type1 =:= Type, maps:is_key(group, MD) =:= false]
end,
Groups = maps:groups_from_list(fun (T)->element(1,T) end,
Expand Down
29 changes: 15 additions & 14 deletions make/ex_doc.exs
Original file line number Diff line number Diff line change
Expand Up @@ -72,16 +72,17 @@ modules =

titles =
modules
|> Enum.reduce(
|> Enum.reduce(
[],
fn module, acc ->
case Code.fetch_docs(module) do
{:docs_v1, _, :erlang, _, _, _, fun_docs} ->
ts = for {{type,_,_},_,_,_,%{group: group}}<-fun_docs, do: {type, group}
ts = for {{type, _, _}, _, _, _, %{group: group}} <- fun_docs, do: {type, group}
acc ++ ts

_ ->
acc
end
acc
end
end
)
|> Enum.group_by(fn e -> elem(e, 0) end)
Expand All @@ -106,16 +107,16 @@ groups_for_docs =
end}
end
) ++
[Callbacks: &(&1[:kind] == :callback)] ++
Enum.map(
Enum.sort(Access.get(titles, :function, [])),
fn {:function, title} ->
{"#{title}",
fn a ->
a[:kind] == :function && String.equivalent?(Access.get(a, :group, ""), title)
end}
end
)
[Callbacks: &(&1[:kind] == :callback)] ++
Enum.map(
Enum.sort(Access.get(titles, :function, [])),
fn {:function, title} ->
{"#{title}",
fn a ->
a[:kind] == :function && String.equivalent?(Access.get(a, :group, ""), title)
end}
end
)

## Create the correct source url to github
base_url = "https://github.com/" <> System.get_env("BASE_URL", "erlang/otp/blob/master/")
Expand Down

0 comments on commit 8c71b97

Please sign in to comment.