File 0864-Fix-typos-in-lib-tools.patch of Package erlang

From 33a39eae840dedb69483a1c2619d9e6ca94c15c4 Mon Sep 17 00:00:00 2001
From: Kian-Meng Ang <kianmeng@cpan.org>
Date: Wed, 5 Jan 2022 20:33:27 +0800
Subject: [PATCH] Fix typos in lib/tools

---
 lib/tools/c_src/erl_memory.c                         |  2 +-
 lib/tools/doc/src/cover.xml                          |  2 +-
 lib/tools/doc/src/cprof_chapter.xml                  |  2 +-
 lib/tools/doc/src/fprof.xml                          |  4 ++--
 lib/tools/doc/src/fprof_chapter.xml                  |  2 +-
 lib/tools/doc/src/lcnt_chapter.xml                   |  2 +-
 lib/tools/doc/src/notes_history.xml                  |  2 +-
 lib/tools/emacs/erlang-eunit.el                      |  2 +-
 lib/tools/emacs/erlang-skels-old.el                  |  2 +-
 lib/tools/emacs/erlang-start.el                      |  4 ++--
 lib/tools/emacs/erlang.el                            | 12 ++++++------
 lib/tools/emacs/erlang_appwiz.el                     |  8 ++++----
 lib/tools/src/cover.erl                              |  4 ++--
 lib/tools/src/fprof.erl                              |  2 +-
 lib/tools/src/tags.erl                               |  2 +-
 lib/tools/test/cover_SUITE.erl                       |  6 +++---
 lib/tools/test/emacs_SUITE_data/comments             |  6 +++---
 lib/tools/test/emacs_SUITE_data/funcs                |  2 +-
 lib/tools/test/emacs_SUITE_data/highlight            |  4 ++--
 lib/tools/test/eprof_SUITE_data/eprof_suite_test.erl |  4 ++--
 lib/tools/test/xref_SUITE.erl                        |  2 +-
 21 files changed, 38 insertions(+), 38 deletions(-)

diff --git a/lib/tools/c_src/erl_memory.c b/lib/tools/c_src/erl_memory.c
index bbd4b3f2ef..78f3cc9caa 100644
--- a/lib/tools/c_src/erl_memory.c
+++ b/lib/tools/c_src/erl_memory.c
@@ -666,7 +666,7 @@ write_title(char **bufp, size_t *overflow, size_t width, char *str)
      * Writes at least one '|' character at the beginning.
      * Right aligns "str".
      * If "str" is larger than "width - 1" and overflow is NULL,
-     * then "str" is trucated; otherwise, string is not truncated.
+     * then "str" is truncated; otherwise, string is not truncated.
      */
 
     if (width <= 0)
diff --git a/lib/tools/doc/src/cover.xml b/lib/tools/doc/src/cover.xml
index 9bcaa9227d..93ff83fc21 100644
--- a/lib/tools/doc/src/cover.xml
+++ b/lib/tools/doc/src/cover.xml
@@ -110,7 +110,7 @@
     <p>If the connection to a remote node goes down, the main node
       will mark it as lost. If the node comes back it will be added
       again. If the remote node was alive during the disconnected
-      periode, cover data from before and during this periode will be
+      period, cover data from before and during this period will be
       included in the analysis.</p>
   </description>
   <funcs>
diff --git a/lib/tools/doc/src/cprof_chapter.xml b/lib/tools/doc/src/cprof_chapter.xml
index af13b8d8d7..f38c72beed 100644
--- a/lib/tools/doc/src/cprof_chapter.xml
+++ b/lib/tools/doc/src/cprof_chapter.xml
@@ -37,7 +37,7 @@
     </p>
   <p><c>cprof</c> uses breakpoints similar to local call trace,
     but containing counters, to collect profiling
-    data. Therfore there is no need for special compilation of any
+    data. Therefore there is no need for special compilation of any
     module to be profiled. 
     </p>
   <p><c>cprof</c> presents all profiled modules in decreasing total
diff --git a/lib/tools/doc/src/fprof.xml b/lib/tools/doc/src/fprof.xml
index e7e7ad69f3..a9fe6a9f4b 100644
--- a/lib/tools/doc/src/fprof.xml
+++ b/lib/tools/doc/src/fprof.xml
@@ -485,7 +485,7 @@
           <item>Includes a section containing call statistics
            for all calls regardless of process, in the analysis.</item>
           <tag><c>{totals, false}</c></tag>
-          <item>Supresses the totals section in the analysis, which is
+          <item>Suppresses the totals section in the analysis, which is
            the default.</item>
           <tag><c>details</c>| <c>{details, true}</c></tag>
           <item>Prints call statistics for each process in the
@@ -686,7 +686,7 @@ create_file_slow(FD, M, N) ->
   {{fprof,apply_start_stop,4},            1,    0.000,    0.000}],     
  { suspend,                             299,   32.002,    0.000},     %
  [ ]}.</pre>
-    <p>We find no particulary long suspend times, so no function seems
+    <p>We find no particularly long suspend times, so no function seems
       to have waited in a receive statement. Actually,
       <c>prim_file:drv_command/4</c> contains a receive statement, but
       in this test program, the message lies in the process receive
diff --git a/lib/tools/doc/src/fprof_chapter.xml b/lib/tools/doc/src/fprof_chapter.xml
index 65ffcede1a..23797b9ca8 100644
--- a/lib/tools/doc/src/fprof_chapter.xml
+++ b/lib/tools/doc/src/fprof_chapter.xml
@@ -37,7 +37,7 @@
     processes.
     </p>
   <p><c>fprof</c> uses tracing with timestamps to collect profiling
-    data. Therfore there is no need for special compilation of any
+    data. Therefore there is no need for special compilation of any
     module to be profiled.
     </p>
   <p><c>fprof</c> presents wall clock times from the host machine OS,
diff --git a/lib/tools/doc/src/lcnt_chapter.xml b/lib/tools/doc/src/lcnt_chapter.xml
index c8afd7063d..d50c45d22d 100644
--- a/lib/tools/doc/src/lcnt_chapter.xml
+++ b/lib/tools/doc/src/lcnt_chapter.xml
@@ -42,7 +42,7 @@
 	completed its access to the resource and unlocked it. The <c>lcnt</c> tool measures these lock conflicts.
     </p>
     <p>
-	Locks has an inherent cost in execution time and memory space. It takes time initialize, destroy, aquiring or releasing locks. To decrease lock contention it
+	Locks has an inherent cost in execution time and memory space. It takes time initialize, destroy, acquiring or releasing locks. To decrease lock contention it
 	some times necessary to use finer grained locking strategies. This will usually also increase the locking overhead and hence there is a tradeoff
 	between lock contention and overhead. In general, lock contention increases with the number of threads running concurrently. The <c>lcnt</c> tool does not measure locking overhead.
     </p>
diff --git a/lib/tools/doc/src/notes_history.xml b/lib/tools/doc/src/notes_history.xml
index d955cbde69..933f70122e 100644
--- a/lib/tools/doc/src/notes_history.xml
+++ b/lib/tools/doc/src/notes_history.xml
@@ -91,7 +91,7 @@
           <p>Own Id: OTP-4594</p>
         </item>
         <item>
-          <p>Improvments for support of Emacs 21 contributed by Dave
+          <p>Improvements for support of Emacs 21 contributed by Dave
             Love. The bulk of the changes are actually cosmetic
             commentary/doc fixes. The significant ones make it play
             better with Emacs 21 with up-to-date facilities. In
diff --git a/lib/tools/emacs/erlang-eunit.el b/lib/tools/emacs/erlang-eunit.el
index 1130bc0cde..560f77660b 100644
--- a/lib/tools/emacs/erlang-eunit.el
+++ b/lib/tools/emacs/erlang-eunit.el
@@ -36,7 +36,7 @@ a source file.  The first directory in the list will be used,
 if there is no match.")
 
 (defvar erlang-eunit-autosave nil
-  "*Set to non-nil to automtically save unsaved buffers before running tests.
+  "*Set to non-nil to automatically save unsaved buffers before running tests.
 This is useful, reducing the save-compile-load-test cycle to one keychord.")
 
 (defvar erlang-eunit-recent-info '((mode . nil) (module . nil) (test . nil) (cover . nil))
diff --git a/lib/tools/emacs/erlang-skels-old.el b/lib/tools/emacs/erlang-skels-old.el
index 4087bc3013..0e2dec5b61 100644
--- a/lib/tools/emacs/erlang-skels-old.el
+++ b/lib/tools/emacs/erlang-skels-old.el
@@ -368,7 +368,7 @@ Please see the function `tempo-define-template'.")
     "%% supervisor_bridge callbacks" n
     (erlang-skel-double-separator 2)
     (erlang-skel-separator 2)
-    "%% Funcion: init(Args) -> {ok,  Pid, State} |" n
+    "%% Function: init(Args) -> {ok,  Pid, State} |" n
     "%%                        ignore            |" n
     "%%                        {error, Reason}    " n
     "%% Description:Creates a supervisor_bridge process, linked to the calling" n
diff --git a/lib/tools/emacs/erlang-start.el b/lib/tools/emacs/erlang-start.el
index c35f280bf4..a19f72e243 100644
--- a/lib/tools/emacs/erlang-start.el
+++ b/lib/tools/emacs/erlang-start.el
@@ -74,9 +74,9 @@
   "Find manual page for NAME, where NAME is module:function." t)
 
 (autoload 'erlang-find-tag "erlang"
-  "Like `find-tag'.  Capable of retreiving Erlang modules.")
+  "Like `find-tag'.  Capable of retrieving Erlang modules.")
 (autoload 'erlang-find-tag-other-window "erlang"
-  "Like `find-tag-other-window'.  Capable of retreiving Erlang modules.")
+  "Like `find-tag-other-window'.  Capable of retrieving Erlang modules.")
 
 
 ;;
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index 7216d6b6fd..ade51beb7c 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -1466,8 +1466,8 @@ Other commands:
 	(modify-syntax-entry ?\n ">" table)
 	(modify-syntax-entry ?\" "\"" table)
 	(modify-syntax-entry ?# "." table)
-;;	(modify-syntax-entry ?$ "\\" table)   ;; Creates problems with indention afterwards
-;;	(modify-syntax-entry ?$ "'" table)    ;; Creates syntax highlighting and indention problems
+;;	(modify-syntax-entry ?$ "\\" table)   ;; Creates problems with indentation afterwards
+;;	(modify-syntax-entry ?$ "'" table)    ;; Creates syntax highlighting and indentation problems
 	(modify-syntax-entry ?$ "/" table)    ;; Misses the corner case "string that ends with $" 
 	                                      ;; we have to live with that for now..it is the best alternative
 	                                      ;; that can be worked around with "string hat ends with \$" 
@@ -2768,7 +2768,7 @@ Value is list (stack token-start token-type in-what)."
 	    
 	    ((looking-at "\\(fun\\)[^_a-zA-Z0-9]")
 	     ;; Push a new layer if we are defining a `fun'
-	     ;; expression, not when we are refering an existing
+	     ;; expression, not when we are referring an existing
 	     ;; function.  'fun's defines are only indented one level now.
 	     (if (save-excursion
 		   (goto-char (match-end 1))
@@ -2820,7 +2820,7 @@ Value is list (stack token-start token-type in-what)."
 	(forward-char 1))
        (t
 	;; Maybe a character literal, quote the next char to avoid
-	;; situations as $" being seen as the begining of a string.
+	;; situations as $" being seen as the beginning of a string.
 	;; Note the quoting something in the middle of a string is harmless.
 	(quote (following-char)) 
 	(forward-char 1))))
@@ -3222,7 +3222,7 @@ Return nil if inside string, t if in a comment."
 		(progn
 		  (if (memq (car stack-top) '(-> ||))
 		      (erlang-pop stack))
-		  ;; Take parent identation + offset,
+		  ;; Take parent indentation + offset,
 		  ;; else just erlang-indent-level if no parent
 		  (if stack
 		      (+ (erlang-caddr (car stack))
@@ -6068,7 +6068,7 @@ unless the optional NO-DISPLAY is non-nil."
 		erlang-compile-erlang-function
 		module-name
 		(inferior-erlang-format-comma-opts opts))
-      (let (;; Hopefully, noone else will ever use these...
+      (let (;; Hopefully, no one else will ever use these...
 	    (tmpvar "Tmp7236")
 	    (tmpvar2 "Tmp8742"))
 	(format
diff --git a/lib/tools/emacs/erlang_appwiz.el b/lib/tools/emacs/erlang_appwiz.el
index 73605c7858..1928ea0279 100644
--- a/lib/tools/emacs/erlang_appwiz.el
+++ b/lib/tools/emacs/erlang_appwiz.el
@@ -272,7 +272,7 @@ creating the root directory and for naming application files."
      erlang-skel-normal-header erlang-skel-header)
     ("Large Header"  "large-header"
      erlang-skel-large-header erlang-skel-header)
-    ("No Moudle Header"  "nomodule-header"
+    ("No Module Header"  "nomodule-header"
      erlang-skel-nomodule-header erlang-skel-header)
     ()
     ("Small Server"   "small-server"
@@ -302,7 +302,7 @@ The first element is the name which shows up in the menu.  The second
 is the `tempo' identfier (The string \"erlang-\" will be added in
 front of it).  The third is the skeleton descriptor, a variable
 containing `tempo' attributes as described in the function
-`tempo-define-template'.  The optinal fourth elements denotes a
+`tempo-define-template'.  The optional fourth elements denotes a
 function which should be called when the menu is selected.
 
 Functions corresponding to every template will be created.  The name
@@ -310,7 +310,7 @@ of the function will be `tempo-template-erlang-X' where `X' is the
 tempo identifier as specified in the second argument of the elements
 in this list.
 
-A list with zero elemets means that the a horisontal line should
+A list with zero elements means that the a horisontal line should
 be placed in the menu.")  
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -451,7 +451,7 @@ Example:
        ((\"Yellow\" function-yellow)
         (\"Blue\" function-blue)))
       nil
-      (\"Region Funtion\" spook-function midnight-variable))
+      (\"Region Function\" spook-function midnight-variable))
 
 Call the function `erlang-menu-init' after modifying this variable.")
 
diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl
index 83ccde524f..a09f6f73de 100644
--- a/lib/tools/src/cover.erl
+++ b/lib/tools/src/cover.erl
@@ -430,7 +430,7 @@ get_mods_and_beams([{Module,File}|ModFiles],Acc) ->
 	    %% Duplicate, but same file so ignore
 	    get_mods_and_beams(ModFiles,Acc);
 	{ok,Module,_OtherFile} ->
-	    %% Duplicate and differnet file - error
+	    %% Duplicate and different file - error
 	    get_mods_and_beams(ModFiles,[{error,{duplicate,Module}}|Acc]);
 	_ ->
 	    get_mods_and_beams(ModFiles,[{ok,Module,File}|Acc])
@@ -1958,7 +1958,7 @@ munge({function,Anno,Function,Arity,Clauses},Vars,_MainFile,on) ->
     {MungedClauses, Vars3} = munge_clauses(Clauses, Vars2),
     {{function,Line,Function,Arity,MungedClauses},Vars3,on};
 munge(Form={attribute,_,file,{MainFile,_}},Vars,MainFile,_Switch) ->
-    {Form,Vars,on};                     % Switch on tranformation!
+    {Form,Vars,on};                     % Switch on transformation!
 munge(Form={attribute,_,file,{_InclFile,_}},Vars,_MainFile,_Switch) ->
     {Form,Vars,off};                    % Switch off transformation!
 munge({attribute,_,compile,{parse_transform,_}},_Vars,_MainFile,_Switch) ->
diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl
index 0d24120b83..e17e15d9f4 100644
--- a/lib/tools/src/fprof.erl
+++ b/lib/tools/src/fprof.erl
@@ -21,7 +21,7 @@
 %%%----------------------------------------------------------------------
 %%% File    : fprof.erl
 %%% Author  : Raimo Niskanen <raimo@erix.ericsson.se>
-%%% Purpose : File tracing profiling tool wich accumulated times.
+%%% Purpose : File tracing profiling tool which accumulated times.
 %%% Created : 18 Jun 2001 by Raimo Niskanen <raimo@erix.ericsson.se>
 %%%----------------------------------------------------------------------
 
diff --git a/lib/tools/src/tags.erl b/lib/tools/src/tags.erl
index df110185a2..8a9409cbec 100644
--- a/lib/tools/src/tags.erl
+++ b/lib/tools/src/tags.erl
@@ -59,7 +59,7 @@
 %%			         directories in `DirList'.
 %%
 %%  subdir(Dir [, Options])   -- Descend recursively down `Dir' and create
-%%				 a TAGS file convering all files found.
+%%				 a TAGS file covering all files found.
 %%  subdirs(DirList [, Options])
 %%			      -- Dito, for all directories in `DirList'.
 %%
diff --git a/lib/tools/test/cover_SUITE.erl b/lib/tools/test/cover_SUITE.erl
index 1393c9d1e1..19550455db 100644
--- a/lib/tools/test/cover_SUITE.erl
+++ b/lib/tools/test/cover_SUITE.erl
@@ -559,7 +559,7 @@ reconnect(Config) ->
     cover:flush(N1),
     rpc:call(N1,f,f1,[]),
 
-    %% This will cause first casue the N1 node to initiate a
+    %% This will cause first cause the N1 node to initiate a
     %% disconnect and then call f:f2() when nodes() =:= [] on N1.
     rpc:cast(N1,f,call_f2_when_isolated,[]),
     timer:sleep(500), % allow some to detect disconnect and for f:f2() call
@@ -861,7 +861,7 @@ export_import(Config) when is_list(Config) ->
     ?line ok = cover:stop(),
     
     %% Check that same data exists after import and that info is written about
-    %% data comming from imported file
+    %% data coming from imported file
     ?line ok = cover:import("f_exported"),
     ?line ?t:capture_start(),
     ?line check_f_calls(1,0),
diff --git a/lib/tools/test/eprof_SUITE_data/eprof_suite_test.erl b/lib/tools/test/eprof_SUITE_data/eprof_suite_test.erl
index 4e0c4d3118..89eb81f7cf 100644
--- a/lib/tools/test/eprof_SUITE_data/eprof_suite_test.erl
+++ b/lib/tools/test/eprof_SUITE_data/eprof_suite_test.erl
@@ -22,10 +22,10 @@
 %%% This module implements a priority queue as defined in 
 %%% "Priority Queues and the STL" by Mark Nelson in Dr.Dobb's Journal, Jan 1996
 %%% see http://web2.airmail.net/markn/articles/pq_stl/priority.htm for more
-%%% information. (A heap implementation is planned aswell)
+%%% information. (A heap implementation is planned as well)
 %%%----------------------------------------------------------------------
 %%% The items of the queue is kept priority sorted, and because of that,
-%%% a push() operation costs more than a pop() operation (wich only
+%%% a push() operation costs more than a pop() operation (which only
 %%% needs to return the top item of the queue(read: list)).
 %%%----------------------------------------------------------------------
 %%% The priority queue can be deceptively nice to use when creating for
diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl
index 75ad7a6ff1..3d4faa15e6 100644
--- a/lib/tools/test/xref_SUITE.erl
+++ b/lib/tools/test/xref_SUITE.erl
@@ -1699,7 +1699,7 @@ fun_mfa(Conf) when is_list(Conf) ->
 
     ok.
 
-%% fun M:F/A with varibles.
+%% fun M:F/A with variables.
 fun_mfa_vars(Conf) when is_list(Conf) ->
     Dir = ?copydir,
     File = fname(Dir, "fun_mfa_vars.erl"),
-- 
2.31.1

openSUSE Build Service is sponsored by