File 1326-Fix-typos-in-lib-compiler.patch of Package erlang

From 145e96537a4ef8494ffb3ce9df47a8b52100ea27 Mon Sep 17 00:00:00 2001
From: "Kian-Meng, Ang" <kianmeng@cpan.org>
Date: Mon, 6 Dec 2021 06:14:28 +0800
Subject: [PATCH] Fix typos in lib/compiler

---
 lib/compiler/doc/src/compile.xml                     |  2 +-
 lib/compiler/doc/src/notes.xml                       | 12 ++++++------
 lib/compiler/src/beam_jump.erl                       | 12 ++++++------
 lib/compiler/src/beam_ssa.erl                        |  2 +-
 lib/compiler/src/beam_ssa_bool.erl                   |  4 ++--
 lib/compiler/src/beam_ssa_bsm.erl                    |  2 +-
 lib/compiler/src/beam_ssa_codegen.erl                |  2 +-
 lib/compiler/src/beam_ssa_opt.erl                    | 10 +++++-----
 lib/compiler/src/beam_ssa_pre_codegen.erl            |  4 ++--
 lib/compiler/src/beam_ssa_share.erl                  |  2 +-
 lib/compiler/src/beam_ssa_type.erl                   |  2 +-
 lib/compiler/src/cerl_inline.erl                     | 10 +++++-----
 lib/compiler/src/compile.erl                         |  4 ++--
 lib/compiler/src/genop.tab                           |  4 ++--
 lib/compiler/src/rec_env.erl                         |  2 +-
 lib/compiler/src/sys_core_bsm.erl                    |  2 +-
 lib/compiler/src/sys_core_fold.erl                   |  2 +-
 lib/compiler/src/v3_core.erl                         |  8 ++++----
 lib/compiler/src/v3_kernel.erl                       |  6 +++---
 lib/compiler/test/beam_jump_SUITE.erl                |  2 +-
 lib/compiler/test/beam_ssa_SUITE.erl                 |  4 ++--
 lib/compiler/test/bs_construct_SUITE.erl             |  2 +-
 .../test/compilation_SUITE_data/compiler_1.erl       |  8 ++++----
 .../test/compilation_SUITE_data/convopts.erl         |  2 +-
 .../test/compilation_SUITE_data/opt_crash.erl        |  2 +-
 .../test/compilation_SUITE_data/otp_4790.erl         |  2 +-
 lib/compiler/test/compile_SUITE.erl                  |  4 ++--
 lib/compiler/test/compile_SUITE_data/big.erl         |  8 ++++----
 lib/compiler/test/receive_SUITE.erl                  |  2 +-
 .../test/receive_SUITE_data/ref_opt/yes_10.erl       |  2 +-
 .../test/receive_SUITE_data/ref_opt/yes_11.erl       |  2 +-
 lib/compiler/test/trycatch_SUITE.erl                 |  6 +++---
 32 files changed, 69 insertions(+), 69 deletions(-)

diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml
index d6397a60ce..14b3a6cc1b 100644
--- a/lib/compiler/doc/src/notes.xml
+++ b/lib/compiler/doc/src/notes.xml
@@ -3529,7 +3529,7 @@
 	    Own Id: OTP-8579</p>
         </item>
         <item>
-	    <p>The undocumented, unsupport, and deprecated function
+	    <p>The undocumented, unsupported, and deprecated function
 	    <c>lists:flat_length/1</c> has been removed.</p>
           <p>
 	    Own Id: OTP-8584</p>
@@ -3578,7 +3578,7 @@
         <item>
           <p>
 	    Using complex boolean expressions in ifs could cause the
-	    compiler to either crash or teminate with an internal
+	    compiler to either crash or terminate with an internal
 	    error. (Thanks to Simon Cornish.)</p>
           <p>
 	    Own Id: OTP-8338</p>
@@ -3778,7 +3778,7 @@
             <p>Using <c>andalso</c>/<c>orelse</c> or record access in
             a <c>try</c>...<c>catch</c> could cause a compiler
             crash.</p>
-            <p>Som large and complex functions could require
+            <p>Some large and complex functions could require
             extremely long compilation times (hours or days).</p>
           <p>
             Own Id: OTP-7905</p>
@@ -4678,7 +4678,7 @@
             string could cause the compiler to generate dangerous
             code that could cause a crash at run-time (e.g.
             <c><![CDATA[R#r{a="abc",b=1}]]></c>). (Thanks to Mikael Karlsson.)</p>
-          <p>Unecessary tests (such as a 'case' with two case
+          <p>Unnecessary tests (such as a 'case' with two case
             branches that were identical) could cause the compiler to
             crash. (Thanks to Fredrik Thulin.)</p>
           <p>The validation pass of the compiler could generate an
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 25f7a1fb88..c7d05c5a81 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -107,7 +107,7 @@
 %%% Note: This modules depends on (almost) all branches and jumps only
 %%% going forward, so that we can remove instructions (including definition
 %%% of labels) after any label that has not been referenced by the code
-%%% preceeding the labels. Regarding the few instructions that have backward
+%%% preceding the labels. Regarding the few instructions that have backward
 %%% references to labels, we assume that they only transfer control back
 %%% to an instruction that has already been executed. That is, code such as
 %%%
@@ -708,7 +708,7 @@ collect_labels_1(Is, _Label, _Entry, Acc, St) ->
 
 %% label_defined(Is, Label) -> true | false.
 %%  Test whether the label Label is defined at the start of the instruction
-%%  sequence, possibly preceeded by other label definitions.
+%%  sequence, possibly preceded by other label definitions.
 %%
 is_label_defined([{label,L}|_], L) -> true;
 is_label_defined([{label,_}|Is], L) -> is_label_defined(Is, L);
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index 3f3d162302..54b56d2449 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -615,7 +615,7 @@ i_case(E, Ctxt, Ren, Env, S) ->
     %% the arguments of the application to be evaluated *after* the
     %% switch expression, but *before* the body of the selected clause.
     %% Such interleaving is not allowed in general, and it does not seem
-    %% worthwile to make a more powerful transformation here. Therefore,
+    %% worthwhile to make a more powerful transformation here. Therefore,
     %% the clause bodies are conservatively visited for value if the
     %% context is `application'.
     Ctxt1 = safe_context(Ctxt),
@@ -967,7 +967,7 @@ i_letrec(Es, B, Xs, Ctxt, Ren, Env, NoInline, S) ->
 
     %% Finally, we create new letrec-bindings for any and all
     %% residualised definitions. All referenced functions should have
-    %% been visited; the call to `visit' below is expected to retreive a
+    %% been visited; the call to `visit' below is expected to retrieve a
     %% cached expression.
     Rs1 = keep_referenced(Rs, S4),
     {Es1, S5} = mapfoldl(fun (R, S) ->
@@ -1013,7 +1013,7 @@ i_apply(E, Ctxt, Ren, Env, S) ->
     %% location could be recycled after the flag has been tested, but
     %% there is no real advantage to that, because in practice, only
     %% 4-5% of all created store locations will ever be reused, while
-    %% there will be a noticable overhead for managing the free list.)
+    %% there will be a noticeable overhead for managing the free list.)
     case st__get_app_inlined(L, S3) of
         true ->
             %% The application was inlined, so we have the final
@@ -1124,7 +1124,7 @@ i_call_2(M, F, As, E, S) ->
 %% to rewrite the expression.
 
 i_call_3(M, F, As, E, Ctxt, Env, S) ->
-    %% Note that we extract the results of argument expessions here; the
+    %% Note that we extract the results of argument expressions here; the
     %% expressions could still be sequences with side effects.
     Vs = [concrete(result(A)) || A <- As],
     try apply(atom_val(M), atom_val(F), Vs) of
@@ -2096,7 +2096,7 @@ residualize_operand(Opnd, E, S) ->
     case st__get_opnd_effect(Opnd#opnd.loc, S) of
         true ->
             %% The operand has not been visited, so we do that now, but
-            %% in `effect' context. (Waddell's algoritm does some stuff
+            %% in `effect' context. (Waddell's algorithm does some stuff
             %% here to account specially for the operand size, which
             %% appears unnecessary.)
             {E1, S1} = i(Opnd#opnd.expr, effect, Opnd#opnd.ren,
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index 68935b1980..a11bb6be03 100755
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -170,7 +170,7 @@ BEAM_FORMAT_NUMBER=0
 ##       receive loop at Label.
 25: wait/1
 
-## @spec wait_timeout Lable Time
+## @spec wait_timeout Label Time
 ## @doc  Sets up a timeout of Time milliseconds and saves the address of the
 ##       following instruction as the entry point if the timeout triggers.
 26: wait_timeout/2
@@ -192,7 +192,7 @@ BEAM_FORMAT_NUMBER=0
 38: -int_bnot/3
 
 #
-# Comparision operators.
+# Comparison operators.
 #
 
 ## @spec is_lt Lbl Arg1 Arg2
diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl
index 48d39776dc..753eca4c66 100644
--- a/lib/compiler/src/rec_env.erl
+++ b/lib/compiler/src/rec_env.erl
@@ -478,7 +478,7 @@ get(Key, Env) ->
 -define(MINIMUM_RANGE, 1000).
 -define(START_RANGE_FACTOR, 50).
 -define(MAX_RETRIES, 2).      % retries before enlarging range
--define(ENLARGE_FACTOR, 10).  % range enlargment factor
+-define(ENLARGE_FACTOR, 10).  % range enlargement factor
 
 -ifdef(DEBUG).
 %% If you want to use these process dictionary counters, make sure to
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 1eb7f9778b..864d444f18 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -303,7 +303,7 @@ head(Ps, St) ->
     pattern_list(Ps, St).
 
 %% guard([Expr], State) -> {[Cexpr],State}.
-%%  Build an explict and/or tree of guard alternatives, then traverse
+%%  Build an explicit and/or tree of guard alternatives, then traverse
 %%  top-level and/or tree and "protect" inner tests.
 
 guard([], St) -> {[],St};
@@ -422,7 +422,7 @@ gexpr_not(A, Bools0, St0, Line) ->
             %% which will produce the same result, but may eliminate
             %% redundant is_boolean/1 tests (see unforce/3).
             %%
-            %% Note that this tranformation would not be safe if the
+            %% Note that this transformation would not be safe if the
             %% original expression had been:
             %%
             %%    not(Expr =:= true)
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index c764c814a2..bf3fd01986 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -337,7 +337,7 @@ expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) ->
     {Type,St1} = case call_type(M0, F0, Ar) of
 		     error ->
 			 %% Invalid call (e.g. M:42/3). Issue a warning,
-			 %% and let the generated code use the old explict apply.
+			 %% and let the generated code use the old explicit apply.
 			 {old_apply,add_warning(get_line(A), bad_call, A, St0)};
 		     Type0 ->
 			 {Type0,St0}
diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl
index d61054bb09..7334ca303a 100644
--- a/lib/compiler/test/bs_construct_SUITE.erl
+++ b/lib/compiler/test/bs_construct_SUITE.erl
@@ -164,7 +164,7 @@ l(I_13, I_big1, I_16, Bin) ->
      ?T(<<869:16/little,3479:I_13,Bin/binary,7:1/unit:3,Bin/binary>>,
         [101,3,108,189,42,214,31,165,90,195]),
 
-     %% Test of aligment flag.
+     %% Test of alignment flag.
      ?T(<<0:I_13/unit:8,1:6,0:2>>,
 	[0,0,0,0,0,0,0,0,0,0,0,0,0,4]),
 
diff --git a/lib/compiler/test/compilation_SUITE_data/compiler_1.erl b/lib/compiler/test/compilation_SUITE_data/compiler_1.erl
index 87985bdf80..ad65677275 100644
--- a/lib/compiler/test/compilation_SUITE_data/compiler_1.erl
+++ b/lib/compiler/test/compilation_SUITE_data/compiler_1.erl
@@ -116,13 +116,13 @@ compiler_1() -> ok.
 %%% test/0
 %%% 
 %%%    Run the complete test suite.
-%%%    Reads Nodes from nodes.profile and starts them if neccessary.
+%%%    Reads Nodes from nodes.profile and starts them if necessary.
 %%%    Kills Mnesia and wipes out the Mnesia directories as a starter.
 %%%
 %%% test/1
 %%%
 %%%    Run parts of the test suite.
-%%%    Reads Nodes from nodes.profile and starts them if neccessary.
+%%%    Reads Nodes from nodes.profile and starts them if necessary.
 %%%    Kills Mnesia and wipes out the Mnesia directories as a starter.
 %%%
 %%% test/2
@@ -615,7 +615,7 @@ replica_management(Nodes) ->
     done.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Add and drop indecies
+%% Add and drop indices
 
 index_lifecycle(suite) ->
     [ add_table_index, create_live_table_index, del_table_index ].
@@ -689,7 +689,7 @@ del_table_index(Nodes) ->
     done.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Syncronize table with log or disc
+%% Synchronize table with log or disc
 %% 
 table_sync(suite) -> 
     [ dump_tables, dump_log, change_dump_log_config, wait_for_tables, force_load_table ].
diff --git a/lib/compiler/test/compilation_SUITE_data/convopts.erl b/lib/compiler/test/compilation_SUITE_data/convopts.erl
index 8404eb82fd..3a0f1c5b07 100644
--- a/lib/compiler/test/compilation_SUITE_data/convopts.erl
+++ b/lib/compiler/test/compilation_SUITE_data/convopts.erl
@@ -108,7 +108,7 @@ convopts(Opts) ->
 			%% This undocumented clause uses an undocumented 
 			%% feature of the TIPC socket interface that takes 
 			%% advantage of some gory internals of the protocol. 
-			%% It is protocol implementation dependant and 
+			%% It is protocol implementation dependent and 
 			%% breaks the whole idea of location transparency 
 			%% for name addressed messages. Therefore it should 
 			%% only be used when all other possibilities are 
diff --git a/lib/compiler/test/compilation_SUITE_data/opt_crash.erl b/lib/compiler/test/compilation_SUITE_data/opt_crash.erl
index 4643ce61f6..4ea08e97f1 100644
--- a/lib/compiler/test/compilation_SUITE_data/opt_crash.erl
+++ b/lib/compiler/test/compilation_SUITE_data/opt_crash.erl
@@ -45,7 +45,7 @@ test() ->
             nil},
          {'query',nil}}} = URI_Before,
 
-   %% ... some funky code ommitted, not relevant ...
+   %% ... some funky code omitted, not relevant ...
 
    {absoluteURI,
       {scheme,_},
diff --git a/lib/compiler/test/compilation_SUITE_data/otp_4790.erl b/lib/compiler/test/compilation_SUITE_data/otp_4790.erl
index 08769c5303..aec102b581 100644
--- a/lib/compiler/test/compilation_SUITE_data/otp_4790.erl
+++ b/lib/compiler/test/compilation_SUITE_data/otp_4790.erl
@@ -32,7 +32,7 @@
 % 		causing a crash at run-time.
 
 % 		The same error could cause tuple tests to be removed,
-% 		but that would propbably only cause a crash if the
+% 		but that would probably only cause a crash if the
 % 		Erlang code was incorrect or if it depended on a catch
 % 		to catch exceptions. Therefore, I consider it unlikely
 % 		that Erlang programs that don't use floating point
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 3a622fe2f8..4860837912 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -428,7 +428,7 @@ makedep_canonicalize_result(Mf, DataDir) ->
     %% Replace the Datadir by "$(srcdir)".
     Mf1 = re:replace(Mf0, DataDir, "$(srcdir)/",
       [global,multiline,{return,list}]),
-    %% Long lines are splitted, put back everything on one line.
+    %% Long lines are split, put back everything on one line.
     Mf2 = re:replace(Mf1, "\\\\\n  ", "", [global,multiline,{return,list}]),
     list_to_binary(Mf2).
 
@@ -774,7 +774,7 @@ install_crypto_key(Key) ->
 	end,
     ok = beam_lib:crypto_key_fun(F).
 
-%% Miscellanous tests, mainly to get better coverage.
+%% Miscellaneous tests, mainly to get better coverage.
 cover(Config) when is_list(Config) ->
     io:format("~p\n", [compile:options()]),
     ok.
diff --git a/lib/compiler/test/compile_SUITE_data/big.erl b/lib/compiler/test/compile_SUITE_data/big.erl
index 765c71c07d..359fbf5c97 100644
--- a/lib/compiler/test/compile_SUITE_data/big.erl
+++ b/lib/compiler/test/compile_SUITE_data/big.erl
@@ -116,13 +116,13 @@ compiler_1() -> ok.
 %%% test/0
 %%% 
 %%%    Run the complete test suite.
-%%%    Reads Nodes from nodes.profile and starts them if neccessary.
+%%%    Reads Nodes from nodes.profile and starts them if necessary.
 %%%    Kills Mnesia and wipes out the Mnesia directories as a starter.
 %%%
 %%% test/1
 %%%
 %%%    Run parts of the test suite.
-%%%    Reads Nodes from nodes.profile and starts them if neccessary.
+%%%    Reads Nodes from nodes.profile and starts them if necessary.
 %%%    Kills Mnesia and wipes out the Mnesia directories as a starter.
 %%%
 %%% test/2
@@ -615,7 +615,7 @@ replica_management(Nodes) ->
     done.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Add and drop indecies
+%% Add and drop indices
 
 index_lifecycle(suite) ->
     [ add_table_index, create_live_table_index, del_table_index ].
@@ -689,7 +689,7 @@ del_table_index(Nodes) ->
     done.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Syncronize table with log or disc
+%% Synchronize table with log or disc
 %% 
 table_sync(suite) -> 
     [ dump_tables, dump_log, change_dump_log_config, wait_for_tables, force_load_table ].
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_10.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_10.erl
index 7ce6e6103c..ea228d4ac6 100644
--- a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_10.erl
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_10.erl
@@ -7,7 +7,7 @@
 f() ->
     Ref = make_ref(),
     receive
-	%% Artifical example to cover more code in beam_receive.
+	%% Artificial example to cover more code in beam_receive.
 	{X,Y} when Ref =/= X, Ref =:= Y ->
 	    ok
     end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_11.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_11.erl
index 62f439fc42..b58d9f7561 100644
--- a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_11.erl
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_11.erl
@@ -4,7 +4,7 @@
 ?MODULE() ->
     ok.
 
-%% Artifical example to cover more code in beam_receive.
+%% Artificial example to cover more code in beam_receive.
 do_call(Process, Request) ->
     Mref = erlang:monitor(process, Process),
     Process ! Request,
diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl
index 1cde10adce..17cf7ff4d5 100644
--- a/lib/compiler/test/trycatch_SUITE.erl
+++ b/lib/compiler/test/trycatch_SUITE.erl
@@ -121,7 +121,7 @@ basic(Conf) when is_list(Conf) ->
     %% Try/of
     ok = try V of
 	     {a,variable} -> ok
-	 catch nisse -> erro
+	 catch nisse -> error
 	 end,
 
     ok.
@@ -1015,7 +1015,7 @@ do_plain_catch_list(X) ->
 andalso_orelse(Config) when is_list(Config) ->
     {2,{a,42}} = andalso_orelse_1(true, {a,42}),
     {b,{b}} = andalso_orelse_1(false, {b}),
-    {catched,no_tuple} = andalso_orelse_1(false, no_tuple),
+    {caught,no_tuple} = andalso_orelse_1(false, no_tuple),
 
     ok = andalso_orelse_2({type,[a]}),
     also_ok = andalso_orelse_2({type,[]}),
@@ -1031,7 +1031,7 @@ andalso_orelse_1(A, B) ->
 		 element(1, B)
 	 end
      catch error:_ ->
-	     catched
+	     caught
      end,B}.
 
 andalso_orelse_2({Type,Keyval}) ->
-- 
2.31.1

openSUSE Build Service is sponsored by