From: rwild Date: Sun, 13 Apr 2008 17:41:15 +0000 (+0000) Subject: gcc/ada/ X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=commitdiff_plain;h=1a34e48c1d7cf4f23d39788e46f64629cddf53b9 gcc/ada/ * sem_ch10.adb, sem_ch10.ads, sem_ch12.adb, sem_ch12.ads, sem_ch13.adb, sem_ch13.ads, sem_ch3.adb, sem_ch4.adb, sem_ch5.adb, sem_ch6.adb, sem_ch6.ads, sem_ch8.adb, sem_ch8.ads, sem_ch9.adb, sem_elab.adb, sem_elab.ads, sem_elim.ads, sem_eval.adb, sem_eval.ads, sem_intr.adb, sem_mech.adb, sem_mech.ads, sem_prag.adb, sem_prag.ads, sem_res.adb, sem_res.ads, sem_type.adb, sem_util.adb, sem_util.ads, sem_warn.adb, sem_warn.ads: Fix comment typos. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@134242 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3e4c64edc41..2cf7f0d3242 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,15 @@ 2008-04-13 Ralf Wildenhues + * sem_ch10.adb, sem_ch10.ads, + sem_ch12.adb, sem_ch12.ads, sem_ch13.adb, sem_ch13.ads, + sem_ch3.adb, sem_ch4.adb, sem_ch5.adb, sem_ch6.adb, + sem_ch6.ads, sem_ch8.adb, sem_ch8.ads, sem_ch9.adb, + sem_elab.adb, sem_elab.ads, sem_elim.ads, sem_eval.adb, + sem_eval.ads, sem_intr.adb, sem_mech.adb, sem_mech.ads, + sem_prag.adb, sem_prag.ads, sem_res.adb, sem_res.ads, + sem_type.adb, sem_util.adb, sem_util.ads, sem_warn.adb, + sem_warn.ads: Fix comment typos. + * s-secsta.adb, s-sequio.ads, s-shasto.ads, s-soflin.ads, s-stalib.ads, s-stausa.adb, s-stausa.ads, s-strxdr.adb, s-taenca.adb, s-taenca.ads, diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index bd9b5746f3c..637e15351e5 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -489,7 +489,7 @@ package body Sem_Ch10 is -- Avoid checking implicitly generated with clauses, limited -- with clauses or withs that have pragma Elaborate or - -- Elaborate_All apllied. + -- Elaborate_All applied. if Nkind (Clause) = N_With_Clause and then not Implicit_With (Clause) @@ -633,7 +633,7 @@ package body Sem_Ch10 is -- level (i.e. this subunit will be handled on the way down from the -- parent), so at this level we immediately return. If the subunit -- ends up not analyzed, it means that the parent did not contain a - -- stub for it, or that there errors were dectected in some ancestor. + -- stub for it, or that there errors were detected in some ancestor. if Nkind (Unit_Node) = N_Subunit and then not Analyzed (Lib_Unit) @@ -928,7 +928,7 @@ package body Sem_Ch10 is Remove_Unit_From_Visibility (Defining_Entity (Unit_Node)); -- If the unit is an instantiation whose body will be elaborated for - -- inlining purposes, use the the proper entity of the instance. The + -- inlining purposes, use the proper entity of the instance. The -- entity may be missing if the instantiation was illegal. elsif Nkind (Unit_Node) = N_Package_Instantiation @@ -1101,7 +1101,7 @@ package body Sem_Ch10 is or else Is_Preelaborated (Spec_Id) - -- No checks needed if pagma Elaborate_Body present + -- No checks needed if pragma Elaborate_Body present or else Has_Pragma_Elaborate_Body (Spec_Id) @@ -1275,7 +1275,7 @@ package body Sem_Ch10 is and then not Limited_Present (Item) then -- Skip analyzing with clause if no unit, nothing to do (this - -- happens for a with that references a non-existant unit) + -- happens for a with that references a non-existent unit) if Present (Library_Unit (Item)) then Analyze (Item); @@ -1757,7 +1757,7 @@ package body Sem_Ch10 is begin Check_Stub_Level (N); - -- First occurence of name may have been as an incomplete type + -- First occurrence of name may have been as an incomplete type if Present (Nam) and then Ekind (Nam) = E_Incomplete_Type then Nam := Full_View (Nam); @@ -2165,7 +2165,7 @@ package body Sem_Ch10 is begin Check_Stub_Level (N); - -- First occurence of name may have been as an incomplete type + -- First occurrence of name may have been as an incomplete type if Present (Nam) and then Ekind (Nam) = E_Incomplete_Type then Nam := Full_View (Nam); @@ -2660,7 +2660,7 @@ package body Sem_Ch10 is P : Node_Id; function Build_Unit_Name (Nam : Node_Id) return Node_Id; - -- Comment requireed here ??? + -- Comment required here ??? --------------------- -- Build_Unit_Name -- @@ -5477,7 +5477,7 @@ package body Sem_Ch10 is Next_Entity (E); end loop; - -- If the previous search was not sucessful then the entity + -- If the previous search was not successful then the entity -- to be restored in the homonym list is the non-limited view if E = First_Private_Entity (P) then diff --git a/gcc/ada/sem_ch10.ads b/gcc/ada/sem_ch10.ads index 9f6543bd082..066ceecb4bf 100644 --- a/gcc/ada/sem_ch10.ads +++ b/gcc/ada/sem_ch10.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -56,7 +56,7 @@ package Sem_Ch10 is -- private part of a nested package, even if this package appears in -- the visible part of the enclosing compilation unit. This Ada 2005 -- rule imposes extra steps in order to install/remove the private_with - -- clauses of the an enclosing unit. + -- clauses of an enclosing unit. procedure Load_Needed_Body (N : Node_Id; OK : out Boolean); -- Load and analyze the body of a context unit that is generic, or diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 00c9f39ff21..8728bfe4684 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -111,7 +111,7 @@ package body Sem_Ch12 is -- b) Each instantiation copies the original tree, and inserts into it a -- series of declarations that describe the mapping between generic formals -- and actuals. For example, a generic In OUT parameter is an object - -- renaming of the corresponing actual, etc. Generic IN parameters are + -- renaming of the corresponding actual, etc. Generic IN parameters are -- constant declarations. -- c) In order to give the right visibility for these renamings, we use @@ -465,7 +465,7 @@ package body Sem_Ch12 is function Is_Generic_Formal (E : Entity_Id) return Boolean; -- Utility to determine whether a given entity is declared by means of - -- of a formal parameter declaration. Used to set properly the visiblity + -- of a formal parameter declaration. Used to set properly the visibility -- of generic formals of a generic package declared with a box or with -- partial parametrization. @@ -666,7 +666,7 @@ package body Sem_Ch12 is -- -- Nodes that are selected components in the parse tree may be rewritten -- as expanded names after resolution, and must be treated as potential - -- entity holders. which is why they also have an Associated_Node. + -- entity holders, which is why they also have an Associated_Node. -- -- Nodes that do not come from source, such as freeze nodes, do not appear -- in the generic tree, and need not have an associated node. @@ -802,7 +802,7 @@ package body Sem_Ch12 is (Pack_Id : Entity_Id; Is_Package : Boolean := True); -- Restore the private views of external types, and unmark the generic - -- renamings of actuals, so that they become comptible subtypes again. + -- renamings of actuals, so that they become compatible subtypes again. -- For subprograms, Pack_Id is the package constructed to hold the -- renamings. @@ -882,7 +882,7 @@ package body Sem_Ch12 is Default_Formals : constant List_Id := New_List; -- If an Other_Choice is present, some of the formals may be defaulted. - -- To simplify the treatement of visibility in an instance, we introduce + -- To simplify the treatment of visibility in an instance, we introduce -- individual defaults for each such formal. These defaults are -- appended to the list of associations and replace the Others_Choice. @@ -1442,8 +1442,8 @@ package body Sem_Ch12 is end loop; end; - -- If this is a formal package. normalize the parameter list by adding - -- explicit box asssociations for the formals that are covered by an + -- If this is a formal package, normalize the parameter list by adding + -- explicit box associations for the formals that are covered by an -- Others_Choice. if not Is_Empty_List (Default_Formals) then @@ -1967,7 +1967,7 @@ package body Sem_Ch12 is -- The formal package is rewritten so that its parameters are replaced -- with corresponding declarations. For parameters with bona fide -- associations these declarations are created by Analyze_Associations - -- as for aa regular instantiation. For boxed parameters, we preserve + -- as for a regular instantiation. For boxed parameters, we preserve -- the formal declarations and analyze them, in order to introduce -- entities of the right kind in the environment of the formal. @@ -3180,7 +3180,7 @@ package body Sem_Ch12 is -- body to instantiate until the enclosing generic is instantiated -- and there is an actual for the formal package. If the formal -- package has parameters, we build a regular package instance for - -- it, that preceeds the original formal package declaration. + -- it, that precedes the original formal package declaration. if In_Open_Scopes (Scope (Scope (Gen_Unit))) then declare @@ -3338,8 +3338,9 @@ package body Sem_Ch12 is -- on current node so context is complete for analysis (including -- nested instantiations). If this is the main unit, the declaration -- eventually replaces the instantiation node. If the instance body - -- is later created, it replaces the instance node, and the declation - -- is attached to it (see Build_Instance_Compilation_Unit_Nodes). + -- is created later, it replaces the instance node, and the + -- declaration is attached to it (see + -- Build_Instance_Compilation_Unit_Nodes). else if Cunit_Entity (Current_Sem_Unit) = Defining_Entity (N) then @@ -3535,7 +3536,7 @@ package body Sem_Ch12 is -- removed previously. -- If current scope is the body of a child unit, remove context of - -- spec as well. If an enclosing scope is an instance body. the + -- spec as well. If an enclosing scope is an instance body, the -- context has already been removed, but the entities in the body -- must be made invisible as well. @@ -4514,7 +4515,7 @@ package body Sem_Ch12 is if No (E1) then return; - -- If the formal entity comes from a formal declaration. it was + -- If the formal entity comes from a formal declaration, it was -- defaulted in the formal package, and no check is needed on it. elsif Nkind (Parent (E2)) = N_Formal_Object_Declaration then @@ -4701,7 +4702,7 @@ package body Sem_Ch12 is begin -- The instantiation appears before the generic body if we are in the -- scope of the unit containing the generic, either in its spec or in - -- the package body. and before the generic body. + -- the package body, and before the generic body. if Ekind (Gen_Comp) = E_Package_Body then Gen_Comp := Spec_Entity (Gen_Comp); @@ -5777,7 +5778,7 @@ package body Sem_Ch12 is -- If we are not instantiating, then this is where we load and -- analyze subunits, i.e. at the point where the stub occurs. A - -- more permissivle system might defer this analysis to the point + -- more permissible system might defer this analysis to the point -- of instantiation, but this seems to complicated for now. if not Instantiating then @@ -5796,7 +5797,7 @@ package body Sem_Ch12 is Error_Node => N); -- If the proper body is not found, a warning message will be - -- emitted when analyzing the stub, or later at the the point + -- emitted when analyzing the stub, or later at the point -- of instantiation. Here we just leave the stub as is. if Unum = No_Unit then @@ -5863,7 +5864,7 @@ package body Sem_Ch12 is -- unit field of N points to the parent unit (which is a compilation -- unit) and need not (and cannot!) be copied. - -- When the proper body of the stub is analyzed, thie library_unit link + -- When the proper body of the stub is analyzed, the library_unit link -- is used to establish the proper context (see sem_ch10). -- The other fields of a compilation unit are copied as usual @@ -6253,7 +6254,7 @@ package body Sem_Ch12 is end loop; end Find_Depth; - -- Start of procesing for Earlier + -- Start of processing for Earlier begin Find_Depth (P1, D1); @@ -6370,7 +6371,7 @@ package body Sem_Ch12 is begin -- If the instance and the generic body appear within the same unit, and - -- the instance preceeds the generic, the freeze node for the instance + -- the instance precedes the generic, the freeze node for the instance -- must appear after that of the generic. If the generic is nested -- within another instance I2, then current instance must be frozen -- after I2. In both cases, the freeze nodes are those of enclosing @@ -6775,7 +6776,7 @@ package body Sem_Ch12 is -- The inherited context is attached to the enclosing compilation -- unit. This is either the main unit, or the declaration for the - -- main unit (in case the instantation appears within the package + -- main unit (in case the instantiation appears within the package -- declaration and the main unit is its body). Current_Unit := Parent (Inst); @@ -7260,7 +7261,7 @@ package body Sem_Ch12 is Actual_Ent : Entity_Id); -- Associates the formal entity with the actual. In the case -- where Formal_Ent is a formal package, this procedure iterates - -- through all of its formals and enters associations betwen the + -- through all of its formals and enters associations between the -- actuals occurring in the formal package's corresponding actual -- package (given by Actual_Ent) and the formal package's formal -- parameters. This procedure recurses if any of the parameters is @@ -7277,7 +7278,7 @@ package body Sem_Ch12 is procedure Map_Entities (Form : Entity_Id; Act : Entity_Id); -- Within the generic part, entities in the formal package are -- visible. To validate subsequent type declarations, indicate - -- the correspondence betwen the entities in the analyzed formal, + -- the correspondence between the entities in the analyzed formal, -- and the entities in the actual package. There are three packages -- involved in the instantiation of a formal package: the parent -- generic P1 which appears in the generic declaration, the fake @@ -8621,7 +8622,7 @@ package body Sem_Ch12 is ("cannot find body of generic package &", Inst_Node, Gen_Unit); -- Don't attempt to perform any cleanup actions if some other error - -- was aready detected, since this can cause blowups. + -- was already detected, since this can cause blowups. else return; @@ -8646,7 +8647,7 @@ package body Sem_Ch12 is Build_Elaboration_Entity (Parent (Inst_Node), Act_Decl_Id); -- If the instantiation is not a library unit, then append the - -- declaration to the list of implicitly generated entities. unless + -- declaration to the list of implicitly generated entities, unless -- it is already a list member which means that it was already -- processed @@ -8715,7 +8716,7 @@ package body Sem_Ch12 is Set_Has_Completion (Anon_Id); return; - -- For other cases, commpile the body + -- For other cases, compile the body else Load_Parent_Of_Generic @@ -8770,7 +8771,7 @@ package body Sem_Ch12 is Check_Generic_Actuals (Pack_Id, False); -- Generate a reference to link the visible subprogram instance to - -- the the generic body, which for navigation purposes is the only + -- the generic body, which for navigation purposes is the only -- available source for the instance. Generate_Reference @@ -9386,7 +9387,7 @@ package body Sem_Ch12 is Abandon_Instantiation (Actual); end if; - -- Ada 2005 (AI-443): Synchronized formal derived type ckecks. Note + -- Ada 2005 (AI-443): Synchronized formal derived type checks. Note -- that the formal type declaration has been rewritten as a private -- extension. @@ -10709,7 +10710,7 @@ package body Sem_Ch12 is -- Within a nested instantiation, a defaulted actual is an empty -- association, so nothing to analyze. If the subprogram actual - -- isan attribute, analyze prefix only, because actual is not a + -- is an attribute, analyze prefix only, because actual is not a -- complete attribute reference. -- If actual is an allocator, analyze expression only. The full @@ -11018,7 +11019,7 @@ package body Sem_Ch12 is -- package itself. If the instance is a subprogram, all entities -- in the corresponding package are renamings. If this entity is -- a formal package, make its own formals private as well. The - -- actual in this case is itself the renaming of an instantation. + -- actual in this case is itself the renaming of an instantiation. -- If the entity is not a package renaming, it is the entity -- created to validate formal package actuals: ignore. @@ -11467,7 +11468,7 @@ package body Sem_Ch12 is Next (Act2); end loop; - -- Find the associations added for default suprograms + -- Find the associations added for default subprograms if Present (Act2) then while Nkind (Act2) /= N_Generic_Association diff --git a/gcc/ada/sem_ch12.ads b/gcc/ada/sem_ch12.ads index 689e597b1ce..7ebb2e88342 100644 --- a/gcc/ada/sem_ch12.ads +++ b/gcc/ada/sem_ch12.ads @@ -130,7 +130,7 @@ package Sem_Ch12 is -- an inlined body (so that errout can distinguish cases for generating -- error messages, otherwise the treatment is identical). In this call -- N is the subprogram body and E is the defining identifier of the - -- subprogram in quiestion. The resulting Sloc adjustment factor is + -- subprogram in question. The resulting Sloc adjustment factor is -- saved as part of the internal state of the Sem_Ch12 package for use -- in subsequent calls to copy nodes. diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 1b6eece5782..93d66270e74 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -67,13 +67,13 @@ package body Sem_Ch13 is procedure Alignment_Check_For_Esize_Change (Typ : Entity_Id); -- This routine is called after setting the Esize of type entity Typ. - -- The purpose is to deal with the situation where an aligment has been + -- The purpose is to deal with the situation where an alignment has been -- inherited from a derived type that is no longer appropriate for the -- new Esize value. In this case, we reset the Alignment to unknown. procedure Check_Component_Overlap (C1_Ent, C2_Ent : Entity_Id); -- Given two entities for record components or discriminants, checks - -- if they hav overlapping component clauses and issues errors if so. + -- if they have overlapping component clauses and issues errors if so. function Get_Alignment_Value (Expr : Node_Id) return Uint; -- Given the expression for an alignment value, returns the corresponding @@ -118,7 +118,7 @@ package body Sem_Ch13 is -- call to Validate_Unchecked_Conversions does the actual error -- checking and posting of warnings. The reason for this delayed -- processing is to take advantage of back-annotations of size and - -- alignment values peformed by the back end. + -- alignment values performed by the back end. type UC_Entry is record Enode : Node_Id; -- node used for posting warnings @@ -294,7 +294,7 @@ package body Sem_Ch13 is declare Comps : array (0 .. Num_CC) of Entity_Id; - -- Array to collect component and discrimninant entities. The data + -- Array to collect component and discriminant entities. The data -- starts at index 1, the 0'th entry is for the sort routine. function CP_Lt (Op1, Op2 : Natural) return Boolean; @@ -1490,7 +1490,7 @@ package body Sem_Ch13 is -- The Stack_Bounded_Pool is used internally for implementing -- access types with a Storage_Size. Since it only work -- properly when used on one specific type, we need to check - -- that it is not highjacked improperly: + -- that it is not hijacked improperly: -- type T is access Integer; -- for T'Storage_Size use n; -- type Q is access Float; @@ -2394,7 +2394,7 @@ package body Sem_Ch13 is elsif Present (Component_Clause (Comp)) then - -- Diagose duplicate rep clause, or check consistency + -- Diagnose duplicate rep clause, or check consistency -- if this is an inherited component. In a double fault, -- there may be a duplicate inconsistent clause for an -- inherited component. @@ -2730,7 +2730,7 @@ package body Sem_Ch13 is -- For records longer than System.Storage_Unit, and for those where not -- all components have component clauses, the back end determines the - -- length (it may for example be appopriate to round up the size + -- length (it may for example be appropriate to round up the size -- to some convenient boundary, based on alignment considerations, etc). if Unknown_RM_Size (Rectype) and then Hbit + 1 <= 32 then @@ -3574,7 +3574,7 @@ package body Sem_Ch13 is -- Signed case. Note that we consider types like range 1 .. -1 to be -- signed for the purpose of computing the size, since the bounds have - -- to be accomodated in the base type. + -- to be accommodated in the base type. if Lo < 0 or else Hi < 0 then S := 1; @@ -3775,7 +3775,7 @@ package body Sem_Ch13 is ("representation item must be after full type declaration", N); return True; - -- If the type has incompleted components, a representation clause is + -- If the type has incomplete components, a representation clause is -- illegal but stream attributes and Convention pragmas are correct. elsif Has_Private_Component (T) then @@ -4058,7 +4058,7 @@ package body Sem_Ch13 is -- For enumeration types, we must check each literal to see if the -- representation is the same. Note that we do not permit enumeration - -- reprsentation clauses for Character and Wide_Character, so these + -- representation clauses for Character and Wide_Character, so these -- cases were already dealt with. elsif Is_Enumeration_Type (T1) then diff --git a/gcc/ada/sem_ch13.ads b/gcc/ada/sem_ch13.ads index 204a0832549..427f836f6e7 100644 --- a/gcc/ada/sem_ch13.ads +++ b/gcc/ada/sem_ch13.ads @@ -99,7 +99,7 @@ package Sem_Ch13 is function Rep_Item_Too_Early (T : Entity_Id; N : Node_Id) return Boolean; -- Called at the start of processing a representation clause or a -- representation pragma. Used to check that the representation item - -- is not being applied to an incompleted type or to a generic formal + -- is not being applied to an incomplete type or to a generic formal -- type or a type derived from a generic formal type. Returns False if -- no such error occurs. If this error does occur, appropriate error -- messages are posted on node N, and True is returned. @@ -150,7 +150,7 @@ package Sem_Ch13 is Act_Unit : Entity_Id); -- Validate a call to unchecked conversion. N is the node for the actual -- instantiation, which is used only for error messages. Act_Unit is the - -- entity for the instantiation, from which the actual types etc for this + -- entity for the instantiation, from which the actual types etc. for this -- instantiation can be determined. This procedure makes an entry in a -- table and/or generates an N_Validate_Unchecked_Conversion node. The -- actual checking is done in Validate_Unchecked_Conversions or in the diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 00e471abf66..88ee0d55b18 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -94,7 +94,7 @@ package body Sem_Ch3 is -- Parent_Type is the entity for the parent type in the derived type -- definition and Derived_Type the actual derived type. Is_Completion must -- be set to False if Derived_Type is the N_Defining_Identifier node in N - -- (ie Derived_Type = Defining_Identifier (N)). In this case N is not the + -- (i.e. Derived_Type = Defining_Identifier (N)). In this case N is not the -- completion of a private type declaration. If Is_Completion is set to -- True, N is the completion of a private type declaration and Derived_Type -- is different from the defining identifier inside N (i.e. Derived_Type /= @@ -749,7 +749,7 @@ package body Sem_Ch3 is -- formal part is currently being analyzed, but will be the parent scope -- in the case of a parameterless function, and we always want to use -- the function's parent scope. Finally, if the function is a child - -- unit, we must traverse the the tree to retrieve the proper entity. + -- unit, we must traverse the tree to retrieve the proper entity. elsif Nkind (Related_Nod) = N_Function_Specification and then Nkind (Parent (N)) /= N_Parameter_Specification @@ -2030,7 +2030,7 @@ package body Sem_Ch3 is Set_Primitive_Operations (T, New_Elmt_List); -- Complete the decoration of the class-wide entity if it was already - -- built (ie. during the creation of the limited view) + -- built (i.e. during the creation of the limited view) if Present (CW) then Set_Is_Interface (CW); @@ -2804,7 +2804,7 @@ package body Sem_Ch3 is end if; -- Set Has_Initial_Value if initializing expression present. Note - -- that if there is no initializating expression, we leave the state + -- that if there is no initializing expression, we leave the state -- of this flag unchanged (usually it will be False, but notably in -- the case of exception choice variables, it will already be true). @@ -5969,7 +5969,7 @@ package body Sem_Ch3 is -- which makes the treatment for T1 and T2 identical. -- What we want when inheriting S, is that references to D1 and D2 in R are - -- replaced with references to their correct constraints, ie D1 and D2 in + -- replaced with references to their correct constraints, i.e. D1 and D2 in -- T1 and 1 and X in T2. So all R's discriminant references are replaced -- with either discriminant references in the derived type or expressions. -- This replacement is achieved as follows: before inheriting R's @@ -6049,7 +6049,7 @@ package body Sem_Ch3 is -- The full view of a private extension is handled exactly as described -- above. The model chose for the private view of a private extension is - -- the same for what concerns discriminants (ie they receive the same + -- the same for what concerns discriminants (i.e. they receive the same -- treatment as in the tagged case). However, the private view of the -- private extension always inherits the components of the parent base, -- without replacing any discriminant reference. Strictly speaking this is @@ -7381,7 +7381,7 @@ package body Sem_Ch3 is -- and therefore when reanalyzing "subtype W is G (D => 1);" -- which really looks like "subtype W is Rec (D => 1);" at -- the point of instantiation, we want to find the discriminant - -- that corresponds to D in Rec, ie X. + -- that corresponds to D in Rec, i.e. X. if Present (Original_Discriminant (Id)) then Discr := Find_Corresponding_Discriminant (Id, T); @@ -9193,7 +9193,7 @@ package body Sem_Ch3 is end if; -- Allow incomplete declaration of tags (used to handle forward - -- references to tags). The check on Ada_Tags avoids cicularities + -- references to tags). The check on Ada_Tags avoids circularities -- when rebuilding the compiler. if RTU_Loaded (Ada_Tags) diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 224639983b5..60d3cd3f689 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -132,7 +132,7 @@ package body Sem_Ch4 is -- an invalid selector error message. function Defined_In_Scope (T : Entity_Id; S : Entity_Id) return Boolean; - -- Verify that type T is declared in scope S. Used to find intepretations + -- Verify that type T is declared in scope S. Used to find interpretations -- for operators given by expanded names. This is abstracted as a separate -- function to handle extensions to System, where S is System, but T is -- declared in the extension. @@ -1344,7 +1344,7 @@ package body Sem_Ch4 is if not Is_Overloaded (P) then if Is_Access_Type (Etype (P)) then - -- Set the Etype. We need to go thru Is_For_Access_Subtypes to + -- Set the Etype. We need to go through Is_For_Access_Subtypes to -- avoid other problems caused by the Private_Subtype and it is -- safe to go to the Base_Type because this is the same as -- converting the access value to its Base_Type. @@ -2213,7 +2213,7 @@ package body Sem_Ch4 is (N, Nam, Designated_Type (Subp_Type), Must_Skip); -- The prefix can also be a parameterless function that returns an - -- access to subprogram. in which case this is an indirect call. + -- access to subprogram, in which case this is an indirect call. elsif Is_Access_Type (Subp_Type) and then Ekind (Designated_Type (Subp_Type)) = E_Subprogram_Type @@ -3195,7 +3195,7 @@ package body Sem_Ch4 is -- If the prefix is a private extension, check only the visible -- components of the partial view. This must include the tag, - -- wich can appear in expanded code in a tag check. + -- which can appear in expanded code in a tag check. if Ekind (Type_To_Use) = E_Record_Type_With_Private and then Chars (Selector_Name (N)) /= Name_uTag @@ -3262,7 +3262,7 @@ package body Sem_Ch4 is Set_Original_Discriminant (Sel, Comp); end if; - -- Before declararing an error, check whether this is tagged + -- Before declaring an error, check whether this is tagged -- private type and a call to a primitive operation. elsif Ada_Version >= Ada_05 @@ -5340,8 +5340,8 @@ package body Sem_Ch4 is -- is never appropriate, even when Address is defined as a visible -- Integer type. The reason is that we would really prefer Address -- to behave as a private type, even in this case, which is there - -- only to accomodate oddities of VMS address sizes. If Address is - -- a visible integer type, we get lots of overload ambiguities. + -- only to accommodate oddities of VMS address sizes. If Address + -- is a visible integer type, we get lots of overload ambiguities. if Nkind (N) in N_Binary_Op then declare diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index c569a281845..a1cd552dfe3 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -818,7 +818,7 @@ package body Sem_Ch5 is begin -- Initialize unblocked exit count for statements of begin block - -- plus one for each excption handler that is present. + -- plus one for each exception handler that is present. Unblocked_Exit_Count := 1; @@ -930,7 +930,7 @@ package body Sem_Ch5 is procedure Non_Static_Choice_Error (Choice : Node_Id); -- Error routine invoked by the generic instantiation below when - -- the case statment has a non static choice. + -- the case statement has a non static choice. procedure Process_Statements (Alternative : Node_Id); -- Analyzes all the statements associated to a case alternative. diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 668a2a7b204..4d566d76b5f 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -112,7 +112,7 @@ package body Sem_Ch6 is procedure Build_Body_To_Inline (N : Node_Id; Subp : Entity_Id); -- If a subprogram has pragma Inline and inlining is active, use generic -- machinery to build an unexpanded body for the subprogram. This body is - -- subsequenty used for inline expansions at call sites. If subprogram can + -- subsequently used for inline expansions at call sites. If subprogram can -- be inlined (depending on size and nature of local declarations) this -- function returns true. Otherwise subprogram body is treated normally. -- If proper warnings are enabled and the subprogram contains a construct @@ -673,7 +673,7 @@ package body Sem_Ch6 is then -- Apply constraint check. Note that this is done before the implicit -- conversion of the expression done for anonymous access types to - -- ensure correct generation of the null-excluding check asssociated + -- ensure correct generation of the null-excluding check associated -- with null-excluding expressions found in return statements. Apply_Constraint_Check (Expr, R_Type); @@ -998,7 +998,7 @@ package body Sem_Ch6 is -- The syntactic construct: PREFIX ACTUAL_PARAMETER_PART can denote -- a procedure call or an entry call. The prefix may denote an access -- to subprogram type, in which case an implicit dereference applies. - -- If the prefix is an indexed component (without implicit defererence) + -- If the prefix is an indexed component (without implicit dereference) -- then the construct denotes a call to a member of an entire family. -- If the prefix is a simple name, it may still denote a call to a -- parameterless member of an entry family. Resolution of these various @@ -2200,7 +2200,7 @@ package body Sem_Ch6 is if Nkind (Ostm) = N_Raise_Statement then Set_Trivial_Subprogram (Stm); - -- If null statement, and no following statemennts, turn on flag + -- If null statement, and no following statements, turn on flag elsif Nkind (Stm) = N_Null_Statement and then Comes_From_Source (Stm) @@ -3618,7 +3618,7 @@ package body Sem_Ch6 is begin -- The algorithm checks every overriding dispatching operation against -- all the corresponding overridden dispatching operations, detecting - -- differences in coventions. + -- differences in conventions. Prim_Op_Elmt := First_Elmt (Primitive_Operations (Typ)); while Present (Prim_Op_Elmt) loop @@ -4260,8 +4260,8 @@ package body Sem_Ch6 is then null; - -- A loop with no exit statement or iteration scheme if either - -- an inifite loop, or it has some other exit (raise/return). + -- A loop with no exit statement or iteration scheme is either + -- an infinite loop, or it has some other exit (raise/return). -- In either case, no warning is required. else @@ -6529,7 +6529,7 @@ package body Sem_Ch6 is else Error_Msg_Sloc := Sloc (E); - -- Generate message,with useful additionalwarning if in generic + -- Generate message, with useful additional warning if in generic if Is_Generic_Unit (E) then Error_Msg_N ("previous generic unit cannot be overloaded", S); @@ -6580,9 +6580,9 @@ package body Sem_Ch6 is -- There are some cases when both can be implicit, for example -- when both a literal and a function that overrides it are - -- inherited in a derivation, or when an inhertited operation + -- inherited in a derivation, or when an inherited operation -- of a tagged full type overrides the inherited operation of - -- a private extension. Ada 83 had a special rule for the the + -- a private extension. Ada 83 had a special rule for the -- literal case. In Ada95, the later implicit operation hides -- the former, and the literal is always the former. In the -- odd case where both are derived operations declared at the @@ -7443,7 +7443,7 @@ package body Sem_Ch6 is AS_Needed : Boolean; begin - -- If this is an emtpy initialization procedure, no need to create + -- If this is an empty initialization procedure, no need to create -- actual subtypes (small optimization). if Ekind (Subp) = E_Procedure diff --git a/gcc/ada/sem_ch6.ads b/gcc/ada/sem_ch6.ads index a195945fbc4..a535bd11883 100644 --- a/gcc/ada/sem_ch6.ads +++ b/gcc/ada/sem_ch6.ads @@ -78,7 +78,7 @@ package Sem_Ch6 is (New_Id : Entity_Id; Old_Id : Entity_Id; Err_Loc : Node_Id := Empty); - -- Check that two callable entitites (subprograms, entries, literals) + -- Check that two callable entities (subprograms, entries, literals) -- are fully conformant, post error message if not (RM 6.3.1(17)) with -- the flag being placed on the Err_Loc node if it is specified, and -- on the appropriate component of the New_Id construct if not. Note: @@ -92,7 +92,7 @@ package Sem_Ch6 is Old_Id : Entity_Id; Err_Loc : Node_Id := Empty; Get_Inst : Boolean := False); - -- Check that two callable entitites (subprograms, entries, literals) + -- Check that two callable entities (subprograms, entries, literals) -- are mode conformant, post error message if not (RM 6.3.1(15)) with -- the flag being placed on the Err_Loc node if it is specified, and -- on the appropriate component of the New_Id construct if not. The @@ -114,7 +114,7 @@ package Sem_Ch6 is (New_Id : Entity_Id; Old_Id : Entity_Id; Err_Loc : Node_Id := Empty); - -- Check that two callable entitites (subprograms, entries, literals) + -- Check that two callable entities (subprograms, entries, literals) -- are subtype conformant, post error message if not (RM 6.3.1(16)) -- the flag being placed on the Err_Loc node if it is specified, and -- on the appropriate component of the New_Id construct if not. @@ -123,7 +123,7 @@ package Sem_Ch6 is (New_Id : Entity_Id; Old_Id : Entity_Id; Err_Loc : Node_Id := Empty); - -- Check that two callable entitites (subprograms, entries, literals) + -- Check that two callable entities (subprograms, entries, literals) -- are type conformant, post error message if not (RM 6.3.1(14)) with -- the flag being placed on the Err_Loc node if it is specified, and -- on the appropriate component of the New_Id construct if not. diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index ad03cdb5bea..da77f581327 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -462,7 +462,7 @@ package body Sem_Ch8 is -- gram in an instance, for which special visibility checks apply. function Has_Implicit_Operator (N : Node_Id) return Boolean; - -- N is an expanded name whose selector is an operator name (eg P."+"). + -- N is an expanded name whose selector is an operator name (e.g. P."+"). -- declarative part contains an implicit declaration of an operator if it -- has a declaration of a type to which one of the predefined operators -- apply. The existence of this routine is an implementation artifact. A @@ -1431,7 +1431,7 @@ package body Sem_Ch8 is -- in Sub must also have one. Otherwise the subtype of the Sub's -- formal parameter must exclude null. -- - -- If Ren is a renaming of a formal function and its retrun + -- If Ren is a renaming of a formal function and its return -- profile has a null exclusion, then Sub's return profile must -- have one. Otherwise the subtype of Sub's return profile must -- exclude null. @@ -1957,7 +1957,7 @@ package body Sem_Ch8 is if Is_Actual then null; - -- Guard agaisnt previous errors, and omit renamings of predefined + -- Guard against previous errors, and omit renamings of predefined -- operators. elsif Ekind (Old_S) /= E_Function @@ -3838,7 +3838,7 @@ package body Sem_Ch8 is All_Overloadable := All_Overloadable and Is_Overloadable (E2); -- Ada 2005 (AI-262): Protect against a form of Beujolais effect - -- that can occurr in private_with clauses. Example: + -- that can occur in private_with clauses. Example: -- with A; -- private with B; package A is @@ -4027,7 +4027,7 @@ package body Sem_Ch8 is -- When distribution features are available (Get_PCS_Name /= -- Name_No_DSA), a remote access-to-subprogram type is converted -- into a record type holding whatever information is needed to - -- perform a remote call on an RCI suprogram. In that case we + -- perform a remote call on an RCI subprogram. In that case we -- rewrite any occurrence of the RAS type into the equivalent record -- type here. 'Access attribute references and RAS dereferences are -- then implemented using specific TSSs. However when distribution is @@ -4143,7 +4143,7 @@ package body Sem_Ch8 is -- the entity is unambiguous, because the tree is not -- sufficiently typed at this point for Generate_Reference to -- determine whether this reference modifies the denoted object - -- (because implicit derefences cannot be identified prior to + -- (because implicit dereferences cannot be identified prior to -- full type resolution). -- -- The Is_Actual_Parameter routine takes care of one of these @@ -6110,7 +6110,7 @@ package body Sem_Ch8 is end if; -- If the new use clause appears in the private part of a parent unit - -- it may appear to be redudant w.r.t. a use clause in a child unit, + -- it may appear to be redundant w.r.t. a use clause in a child unit, -- but the previous use clause was needed in the visible part of the -- child, and no warning should be emitted. @@ -6989,7 +6989,7 @@ package body Sem_Ch8 is -- type T ... use P.T; -- The compilation unit is the body of X. GNAT first compiles the - -- spec of X, then procedes to the body. At that point P is marked + -- spec of X, then proceeds to the body. At that point P is marked -- as use visible. The analysis then reinstalls the spec along with -- its context. The use clause P.T is now recognized as redundant, -- but in the wrong context. Do not emit a warning in such cases. diff --git a/gcc/ada/sem_ch8.ads b/gcc/ada/sem_ch8.ads index 1d887aa03b7..45fb07b32cc 100644 --- a/gcc/ada/sem_ch8.ads +++ b/gcc/ada/sem_ch8.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -146,7 +146,7 @@ package Sem_Ch8 is -- return, the contents of the scope stack must be made accessible again. -- The flag Handle_Use indicates whether local use clauses must be -- removed/installed. In the case of inlining of instance bodies, the - -- visiblity handling is done fully in Inline_Instance_Body, and use + -- visibility handling is done fully in Inline_Instance_Body, and use -- clauses are handled there. procedure Set_Use (L : List_Id); diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 86de33e78b7..d9e7ff9ca5a 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -917,7 +917,7 @@ package body Sem_Ch9 is if Nkind (Call) = N_Attribute_Reference then -- Possibly a stream attribute, but definitely illegal. Other - -- illegalitles, such as procedure calls, are diagnosed after + -- illegalities, such as procedure calls, are diagnosed after -- resolution. Error_Msg_N ("entry call alternative requires an entry call", Call); @@ -983,7 +983,7 @@ package body Sem_Ch9 is -- order to make it available to the barrier, we create an additional -- scope, as for a loop, whose only declaration is the index name. This -- loop is not attached to the tree and does not appear as an entity local - -- to the protected type, so its existence need only be knwown to routines + -- to the protected type, so its existence need only be known to routines -- that process entry families. procedure Analyze_Entry_Index_Specification (N : Node_Id) is @@ -2175,7 +2175,7 @@ package body Sem_Ch9 is ("triggering statement must be delay or entry call", Trigger); -- Ada 2005 (AI-345): If a procedure_call_statement is used for a - -- procedure_or_entry_call, the procedure_name or pro- cedure_prefix + -- procedure_or_entry_call, the procedure_name or procedure_prefix -- of the procedure_call_statement shall denote an entry renamed by a -- procedure, or (a view of) a primitive subprogram of a limited -- interface whose first parameter is a controlling parameter. diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index d61ebb09a46..34065991103 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -491,7 +491,7 @@ package body Sem_Elab is -- calls and calls involving object notation) where W_Scope might not -- be in the context of the current unit, and there is an intermediate -- package that is, in which case the Elaborate_All has to be placed - -- on this intedermediate package. These special cases are handled in + -- on this intermediate package. These special cases are handled in -- Set_Elaboration_Constraint. Body_Acts_As_Spec : Boolean; @@ -1795,7 +1795,7 @@ package body Sem_Elab is -- outer level call. -- It is an outer level instantiation from elaboration code, or the - -- instantiated entity is in the same elaboratoin scope. + -- instantiated entity is in the same elaboration scope. -- And in these cases, we will check both the inter-unit case and -- the intra-unit (within a single unit) case. @@ -1877,7 +1877,7 @@ package body Sem_Elab is return; -- Nothing to do if analyzing in special spec-expression mode, since the - -- call is not actualy being made at this time. + -- call is not actually being made at this time. elsif In_Spec_Expression then return; @@ -2408,7 +2408,7 @@ package body Sem_Elab is and then not Restriction_Active (No_Entry_Calls_In_Elaboration_Code) then - -- Runtime elaboration check required. generate check of the + -- Runtime elaboration check required. Generate check of the -- elaboration Boolean for the unit containing the entity. Insert_Elab_Check (N, diff --git a/gcc/ada/sem_elab.ads b/gcc/ada/sem_elab.ads index f6529b8241e..7b85b6f886f 100644 --- a/gcc/ada/sem_elab.ads +++ b/gcc/ada/sem_elab.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1997-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -85,7 +85,7 @@ package Sem_Elab is -- Note on pragma Elaborate. The checking here assumes that a pragma -- Elaborate on a with'ed unit guarantees that subprograms within the -- unit can be called without causing an ABE. This is not in fact the - -- case since pragma Elaborate does not guarantee the transititive + -- case since pragma Elaborate does not guarantee the transitive -- coverage guaranteed by Elaborate_All. However, we leave this issue -- up to the binder, which has generates warnings if there are possible -- problems in the use of pragma Elaborate. diff --git a/gcc/ada/sem_elim.ads b/gcc/ada/sem_elim.ads index dfcad41b3d5..ee9f8a10d4c 100644 --- a/gcc/ada/sem_elim.ads +++ b/gcc/ada/sem_elim.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1997-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -30,7 +30,7 @@ with Types; use Types; package Sem_Elim is procedure Initialize; - -- Initialize for new main souce program + -- Initialize for new main source program procedure Process_Eliminate_Pragma (Pragma_Node : Node_Id; @@ -53,7 +53,7 @@ package Sem_Elim is -- flag on the given entity. procedure Eliminate_Error_Msg (N : Node_Id; E : Entity_Id); - -- Called by the back end on encouterning a call to an eliminated + -- Called by the back end on encountering a call to an eliminated -- subprogram. N is the node for the call, and E is the entity of -- the subprogram being eliminated. diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 7b38241006f..9801df625e5 100644 --- a/gcc/ada/sem_eval.adb +++ b/gcc/ada/sem_eval.adb @@ -57,7 +57,7 @@ package body Sem_Eval is ----------------------------------------- -- The compile time evaluation of expressions is distributed over several - -- Eval_xxx procedures. These procedures are called immediatedly after + -- Eval_xxx procedures. These procedures are called immediately after -- a subexpression is resolved and is therefore accomplished in a bottom -- up fashion. The flags are synthesized using the following approach. @@ -3227,7 +3227,7 @@ package body Sem_Eval is return Ureal_0; end if; - -- If we fall through, we have a node that cannot be interepreted + -- If we fall through, we have a node that cannot be interpreted -- as a compile time constant. That is definitely an error. raise Program_Error; @@ -3307,7 +3307,7 @@ package body Sem_Eval is Typ := Full_View (Typ); end if; - -- For a result of type integer, subsitute an N_Integer_Literal node + -- For a result of type integer, substitute an N_Integer_Literal node -- for the result of the compile time evaluation of the expression. if Is_Integer_Type (Typ) then @@ -3497,7 +3497,7 @@ package body Sem_Eval is end if; -- If any exception occurs, it means that we have some bug in the compiler - -- possibly triggered by a previous error, or by some unforseen peculiar + -- possibly triggered by a previous error, or by some unforeseen peculiar -- occurrence. However, this is only an optimization attempt, so there is -- really no point in crashing the compiler. Instead we just decide, too -- bad, we can't figure out the answer in this case after all. @@ -4097,7 +4097,7 @@ package body Sem_Eval is -- To understand the requirement for this test, see RM 4.9.1(1). -- As is made clear in RM 3.5.4(11), type Integer, for example -- is a constrained subtype with constraint bounds matching the - -- bounds of its corresponding uncontrained base type. In this + -- bounds of its corresponding unconstrained base type. In this -- situation, Integer and Integer'Base do not statically match, -- even though they have the same bounds. diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads index bb6348b3c22..f0dcd522b15 100644 --- a/gcc/ada/sem_eval.ads +++ b/gcc/ada/sem_eval.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -56,7 +56,7 @@ package Sem_Eval is -- Raises_Constraint_Error - -- This flag indicatest that it is known at compile time that the + -- This flag indicates that it is known at compile time that the -- evaluation of an expression raises constraint error. If the -- expression is static, and this flag is off, then it is also known at -- compile time that the expression does not raise constraint error @@ -159,7 +159,7 @@ package Sem_Eval is -- An OK static expression is one that is static in the RM definition sense -- and which does not raise constraint error. For most legality checking -- purposes you should use Is_Static_Expression. For those legality checks - -- where the expression N should not raise constaint error use this + -- where the expression N should not raise constraint error use this -- routine. This routine is *not* to be used in contexts where the test is -- for compile time evaluation purposes. Use Compile_Time_Known_Value -- instead (see section on "Compile-Time Known Values" above). @@ -328,7 +328,7 @@ package Sem_Eval is Int_Real : Boolean := False) return Boolean; -- Returns True if it can be guaranteed at compile time that expression is -- known to be in range of the subtype Typ. If the values of N or of either - -- bouds of Type are unknown at compile time, False will always be + -- bounds of Type are unknown at compile time, False will always be -- returned. A result of False does not mean that the expression is out of -- range, merely that it cannot be determined at compile time that it is in -- range. If Typ is a floating point type or Int_Real is set, any integer @@ -339,8 +339,8 @@ package Sem_Eval is -- is True then any fixed-point value is treated as though it was discrete -- value (i.e. the underlying integer value is used). In this case we use -- the corresponding integer value, both for the bounds of Typ, and for the - -- value of the expression N. If Typ is a discret type and Fixed_Int as - -- well as Int_Real are false, intere values are used throughout. + -- value of the expression N. If Typ is a discrete type and Fixed_Int as + -- well as Int_Real are false, integer values are used throughout. function Is_Out_Of_Range (N : Node_Id; diff --git a/gcc/ada/sem_intr.adb b/gcc/ada/sem_intr.adb index 42d78baf7b1..9d7319759b3 100644 --- a/gcc/ada/sem_intr.adb +++ b/gcc/ada/sem_intr.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -132,7 +132,7 @@ package body Sem_Intr is end if; -- Check for the case of freeing a non-null object which will raise - -- Constaint_Error. Issue warning here, do the expansion in Exp_Intr. + -- Constraint_Error. Issue warning here, do the expansion in Exp_Intr. elsif Cnam = Name_Free and then Can_Never_Be_Null (Etype (Arg1)) @@ -158,7 +158,7 @@ package body Sem_Intr is T2 : Entity_Id; begin - -- Aritnmetic operators + -- Arithmetic operators if Nam = Name_Op_Add or else @@ -304,7 +304,7 @@ package body Sem_Intr is Errint ("unrecognized intrinsic subprogram", E, N); -- We always allow intrinsic specifications in language defined units - -- and in expanded code. We assume that the GNAT implemetors know what + -- and in expanded code. We assume that the GNAT implementors know what -- they are doing, and do not write or generate junk use of intrinsic! elsif not Comes_From_Source (E) diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb index 62f9af85b75..177a39ca671 100644 --- a/gcc/ada/sem_mech.adb +++ b/gcc/ada/sem_mech.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1996-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -183,7 +183,7 @@ package body Sem_Mech is is begin -- Right now we only do some checks for functions returning arguments - -- by desctiptor. Probably mode checks need to be added here ??? + -- by descriptor. Probably mode checks need to be added here ??? if Mech in Descriptor_Codes and then not Is_Formal (Ent) then if Is_Record_Type (Etype (Ent)) then @@ -207,7 +207,7 @@ package body Sem_Mech is begin -- Skip this processing if inside a generic template. Not only is - -- it uneccessary (since neither extra formals nor mechanisms are + -- it unnecessary (since neither extra formals nor mechanisms are -- relevant for the template itself), but at least at the moment, -- procedures get frozen early inside a template so attempting to -- look at the formal types does not work too well if they are @@ -241,7 +241,7 @@ package body Sem_Mech is --------- -- Note: all RM defined conventions are treated the same - -- from the point of view of parameter passing mechanims + -- from the point of view of parameter passing mechanism when Convention_Ada | Convention_Intrinsic | diff --git a/gcc/ada/sem_mech.ads b/gcc/ada/sem_mech.ads index 27edf2219cf..1673a671b0e 100644 --- a/gcc/ada/sem_mech.ads +++ b/gcc/ada/sem_mech.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1996-2007, Free Software Foundation, Inc. -- +-- Copyright (C) 1996-2008, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -144,7 +144,7 @@ package Sem_Mech is -- this call is to set mechanism values for formals and for the -- function return if they have not already been explicitly set by -- a use of an extended Import or Export pragma. The idea is to set - -- mechanism values whereever the semantics is dictated by either + -- mechanism values wherever the semantics is dictated by either -- requirements or implementation advice in the RM, and to leave -- the mechanism set to Default if there is no requirement, so that -- the back-end is free to choose the most efficient method. diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 4dba98da769..b98e0044beb 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -564,7 +564,7 @@ package body Sem_Prag is -- Decls where Decls is the list of declarative items. function Is_Configuration_Pragma return Boolean; - -- Deterermines if the placement of the current pragma is appropriate + -- Determines if the placement of the current pragma is appropriate -- for a configuration pragma. function Is_In_Context_Clause return Boolean; @@ -587,7 +587,7 @@ package body Sem_Prag is -- Common processing for Compile_Time_Error and Compile_Time_Warning procedure Process_Convention (C : out Convention_Id; E : out Entity_Id); - -- Common procesing for Convention, Interface, Import and Export. + -- Common processing for Convention, Interface, Import and Export. -- Checks first two arguments of pragma, and sets the appropriate -- convention value in the specified entity or entities. On return -- C is the convention, E is the referenced entity. @@ -606,7 +606,7 @@ package body Sem_Prag is (Arg_Internal : Node_Id; Arg_External : Node_Id; Arg_Size : Node_Id); - -- Common processing for the pragmass Import/Export_Object. + -- Common processing for the pragmas Import/Export_Object. -- The three arguments correspond to the three named parameters -- of the pragmas. An argument is empty if the corresponding -- parameter is not present in the pragma. @@ -629,7 +629,7 @@ package body Sem_Prag is Arg_First_Optional_Parameter : Node_Id := Empty); -- Common processing for all extended Import and Export pragmas -- applying to subprograms. The caller omits any arguments that do - -- bnot apply to the pragma in question (for example, Arg_Result_Type + -- not apply to the pragma in question (for example, Arg_Result_Type -- can be non-Empty only in the Import_Function and Export_Function -- cases). The argument names correspond to the allowed pragma -- association identifiers. @@ -1486,7 +1486,7 @@ package body Sem_Prag is -------------------------------------- -- A configuration pragma must appear in the context clause of a - -- compilation unit, and only other pragmas may preceed it. Note that + -- compilation unit, and only other pragmas may precede it. Note that -- the test also allows use in a configuration pragma file. procedure Check_Valid_Configuration_Pragma is @@ -2129,7 +2129,7 @@ package body Sem_Prag is -- An interesting improvement here. If an object of type X -- is declared atomic, and the type X is not atomic, that's - -- a pity, since it may not have appropraite alignment etc. + -- a pity, since it may not have appropriate alignment etc. -- We can rescue this in the special case where the object -- and type are in the same unit by just setting the type -- as atomic, so that the back end will process it as atomic. @@ -2831,7 +2831,7 @@ package body Sem_Prag is end if; -- We have a match if the corresponding argument is of an - -- anonymous access type, and its designicated type matches + -- anonymous access type, and its designated type matches -- the type of the prefix of the access attribute return Ekind (Ftyp) = E_Anonymous_Access_Type @@ -3040,7 +3040,7 @@ package body Sem_Prag is then null; - -- In all other cases, set entit as exported + -- In all other cases, set entity as exported else Set_Exported (Ent, Arg_Internal); @@ -3535,7 +3535,7 @@ package body Sem_Prag is function Inlining_Not_Possible (Subp : Entity_Id) return Boolean; -- Returns True if it can be determined at this stage that inlining - -- is not possible, for examle if the body is available and contains + -- is not possible, for example if the body is available and contains -- exception handlers, we prevent inlining, since otherwise we can -- get undefined symbols at link time. This function also emits a -- warning if front-end inlining is enabled and the pragma appears @@ -4808,7 +4808,7 @@ package body Sem_Prag is end; -- An enumeration type defines the pragmas that are supported by the - -- implementation. Get_Pragma_Id (in package Prag) transorms a name + -- implementation. Get_Pragma_Id (in package Prag) transforms a name -- into the corresponding enumeration value for the following case. case Prag_Id is @@ -6249,7 +6249,7 @@ package body Sem_Prag is -- compilation unit. If the pragma appears in some unit -- in the context, there might still be a need for an -- Elaborate_All_Desirable from the current compilation - -- to the the named unit, so we keep the check enabled. + -- to the named unit, so we keep the check enabled. if In_Extended_Main_Source_Unit (N) then Set_Suppress_Elaboration_Warnings @@ -6271,7 +6271,7 @@ package body Sem_Prag is end loop Outer; -- Give a warning if operating in static mode with -gnatwl - -- (elaboration warnings eanbled) switch set. + -- (elaboration warnings enabled) switch set. if Elab_Warnings and not Dynamic_Elaboration_Checks then Error_Msg_N @@ -9001,7 +9001,7 @@ package body Sem_Prag is -- pragma No_Run_Time - -- Note: this pragma is retained for backwards compatibiltiy. + -- Note: this pragma is retained for backwards compatibility. -- See body of Rtsfind for full details on its handling. when Pragma_No_Run_Time => @@ -10567,7 +10567,7 @@ package body Sem_Prag is end if; end Check_OK_Stream_Convert_Function; - -- Start of procecessing for Stream_Convert + -- Start of processing for Stream_Convert begin GNAT_Pragma; @@ -11962,7 +11962,7 @@ package body Sem_Prag is return True; end Add_Config_Static_String; - -- Start of prorcessing for Is_Config_Static_String + -- Start of processing for Is_Config_Static_String begin @@ -11977,8 +11977,8 @@ package body Sem_Prag is -- This function makes use of the following static table which indicates -- whether a given pragma is significant. A value of -1 in this table -- indicates that the reference is significant. A value of zero indicates - -- than appearence as any argument is insignificant, a positive value - -- indicates that appearence in that parameter position is significant. + -- than appearance as any argument is insignificant, a positive value + -- indicates that appearance in that parameter position is significant. -- A value of 99 flags a special case requiring a special check (this is -- used for cases not covered by this standard encoding, e.g. pragma Check diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 7218ff61f7c..1bb51150417 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -75,7 +75,7 @@ package Sem_Prag is -- occurrence is a reference for the purposes of giving warnings about -- unreferenced variables. This function returns True if the reference is -- not a reference from this point of view (e.g. the occurrence in a pragma - -- Pack) and False if it is a real reference (e.g. the occcurrence in a + -- Pack) and False if it is a real reference (e.g. the occurrence in a -- pragma Export); function Is_Pragma_String_Literal (Par : Node_Id) return Boolean; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index b9ef016a498..cfa1a8cd0d7 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -828,7 +828,7 @@ package body Sem_Res is function Uses_SS (T : Entity_Id) return Boolean; -- Check whether the creation of an object of the type will involve -- use of the secondary stack. If T is a record type, this is true - -- if the expression for some component uses the secondary stack, eg. + -- if the expression for some component uses the secondary stack, e.g. -- through a call to a function that returns an unconstrained value. -- False if T is controlled, because cleanups occur elsewhere. @@ -985,7 +985,7 @@ package body Sem_Res is or else Is_Overloaded (N))) -- Rewrite as call if it is an explicit deference of an expression of - -- a subprogram access type, and the suprogram type is not that of a + -- a subprogram access type, and the subprogram type is not that of a -- procedure or entry. or else @@ -2387,7 +2387,7 @@ package body Sem_Res is end if; end if; - -- A user-defined operator is tranformed into a function call at + -- A user-defined operator is transformed into a function call at -- this point, so that further processing knows that operators are -- really operators (i.e. are predefined operators). User-defined -- operators that are intrinsic are just renamings of the predefined @@ -2869,7 +2869,7 @@ package body Sem_Res is Set_Parent (Actval, N); -- Resolve aggregates with their base type, to avoid scope - -- anomalies: the subtype was first built in the suprogram + -- anomalies: the subtype was first built in the subprogram -- declaration, and the current call may be nested. if Nkind (Actval) = N_Aggregate @@ -3585,7 +3585,7 @@ package body Sem_Res is -- 1) Analyze Top_Record -- 2) Analyze Level_1_Coextension -- 3) Analyze Level_2_Coextension - -- 4) Resolve Level_2_Coextnesion. The allocator is marked as a + -- 4) Resolve Level_2_Coextension. The allocator is marked as a -- coextension. -- 5) Expand Level_2_Coextension. A temporary variable Temp_1 is -- generated to capture the allocated object. Temp_1 is attached @@ -3675,7 +3675,7 @@ package body Sem_Res is function Process_Allocator (Nod : Node_Id) return Traverse_Result; -- Recognize an allocator or a rewritten allocator node and add it - -- allong with its nested coextensions to the list of Root. + -- along with its nested coextensions to the list of Root. --------------- -- Copy_List -- @@ -3833,7 +3833,7 @@ package body Sem_Res is -- A special accessibility check is needed for allocators that -- constrain access discriminants. The level of the type of the -- expression used to constrain an access discriminant cannot be - -- deeper than the type of the allocator (in constrast to access + -- deeper than the type of the allocator (in contrast to access -- parameters, where the level of the actual can be arbitrary). -- We can't use Valid_Conversion to perform this check because @@ -3912,7 +3912,7 @@ package body Sem_Res is -- A special accessibility check is needed for allocators that -- constrain access discriminants. The level of the type of the -- expression used to constrain an access discriminant cannot be - -- deeper than the type of the allocator (in constrast to access + -- deeper than the type of the allocator (in contrast to access -- parameters, where the level of the actual can be arbitrary). -- We can't use Valid_Conversion to perform this check because -- in general the type of the allocator is unrelated to the type @@ -6249,7 +6249,7 @@ package body Sem_Res is end if; -- If name was overloaded, set component type correctly now - -- If a misplaced call to an entry family (which has no index typs) + -- If a misplaced call to an entry family (which has no index types) -- return. Error will be diagnosed from calling context. if Is_Array_Type (Array_Type) then @@ -6832,7 +6832,7 @@ package body Sem_Res is B_Typ : constant Entity_Id := Base_Type (Typ); begin - -- Catch attempts to do fixed-point exponentation with universal + -- Catch attempts to do fixed-point exponentiation with universal -- operands, which is a case where the illegality is not caught during -- normal operator analysis. @@ -6939,7 +6939,7 @@ package body Sem_Res is B_Typ := Base_Type (Typ); end if; - -- Straigtforward case of incorrect arguments + -- Straightforward case of incorrect arguments if not Valid_Boolean_Arg (Typ) then Error_Msg_N ("invalid operand type for operator&", N); @@ -7735,8 +7735,8 @@ package body Sem_Res is elsif R_Typ = Any_Character then return; - -- If the type is bit-packed, then we always tranform the string literal - -- into a full fledged aggregate. + -- If the type is bit-packed, then we always transform the string + -- literal into a full fledged aggregate. elsif Is_Bit_Packed_Array (Typ) then null; @@ -8252,7 +8252,7 @@ package body Sem_Res is Rorig := Original_Node (Right_Opnd (Norig)); -- We are looking for cases where the right operand is not - -- parenthesized, and is a bianry operator, multiply, divide, or + -- parenthesized, and is a binary operator, multiply, divide, or -- mod. These are the cases where the grouping can affect results. if Paren_Count (Rorig) = 0 @@ -9120,7 +9120,7 @@ package body Sem_Res is -- Also no need to check when in an instance or inlined body, because -- the legality has been established when the template was analyzed. -- Furthermore, numeric conversions may occur where only a private - -- view of the operand type is visible at the instanciation point. + -- view of the operand type is visible at the instantiation point. -- This results in a spurious error if we check that the operand type -- is a numeric type. @@ -9223,7 +9223,7 @@ package body Sem_Res is -- The case of a reference to an access discriminant from -- within a limited type declaration (which will appear as -- a discriminal) is always illegal because the level of the - -- discriminant is considered to be deeper than any (namable) + -- discriminant is considered to be deeper than any (nameable) -- access type. if Is_Entity_Name (Operand) @@ -9335,7 +9335,7 @@ package body Sem_Res is -- The case of a reference to an access discriminant from -- within a limited type declaration (which will appear as -- a discriminal) is always illegal because the level of the - -- discriminant is considered to be deeper than any (namable) + -- discriminant is considered to be deeper than any (nameable) -- access type. if Is_Entity_Name (Operand) diff --git a/gcc/ada/sem_res.ads b/gcc/ada/sem_res.ads index d8704727c30..70b534bf50c 100644 --- a/gcc/ada/sem_res.ads +++ b/gcc/ada/sem_res.ads @@ -103,7 +103,7 @@ package Sem_Res is -- Several forms of names can denote calls to entities without para- -- meters. The context determines whether the name denotes the entity -- or a call to it. When it is a call, the node must be rebuilt - -- accordingly and renalyzed to obtain possible interpretations. + -- accordingly and reanalyzed to obtain possible interpretations. -- -- The name may be that of an overloadable construct, or it can be an -- explicit dereference of a prefix that denotes an access to subprogram. diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 1c401589fac..b118c37034a 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -932,7 +932,7 @@ package body Sem_Type is -- The context can be a remote access type, and the expression the -- corresponding source type declared in a categorized package, or - -- viceversa. + -- vice versa. elsif Is_Record_Type (T1) and then (Is_Remote_Call_Interface (T1) diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 54925d7b600..9ab77bbf9f8 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2731,7 +2731,7 @@ package body Sem_Util is and then Length_Of_Name (Chars (C)) /= 1 - -- Don't warn for non-source eneities + -- Don't warn for non-source entities and then Comes_From_Source (C) and then Comes_From_Source (Def_Id) @@ -2999,7 +2999,7 @@ package body Sem_Util is (Prim_Params : List_Id; Iface_Params : List_Id) return Boolean; -- Determine whether a subprogram's parameter profile Prim_Params - -- matches that of a potentially overriden interface subprogram + -- matches that of a potentially overridden interface subprogram -- Iface_Params. Also determine if the type of first parameter of -- Iface_Params is an implemented interface. @@ -3088,7 +3088,7 @@ package body Sem_Util is Prim_Param := First (Prim_Params); - -- The first parameter of the potentially overriden subprogram + -- The first parameter of the potentially overridden subprogram -- must be an interface implemented by Prim. if not Is_Interface (Iface_Typ) @@ -3173,7 +3173,7 @@ package body Sem_Util is return Empty; end if; - -- Traverse the homonym chain, looking at a potentially overriden + -- Traverse the homonym chain, looking at a potentially overridden -- subprogram that belongs to an implemented interface. Hom := First_Hom; @@ -4472,7 +4472,7 @@ package body Sem_Util is Set_Result (Unknown); -- Now check size of Expr object. Any size that is not an - -- even multiple of Maxiumum_Alignment is also worrisome + -- even multiple of Maximum_Alignment is also worrisome -- since it may cause the alignment of the object to be less -- than the alignment of the type. @@ -4942,7 +4942,7 @@ package body Sem_Util is then -- Get default expression if any. If there is no declaration -- node, it means we have an internal entity. The parent and - -- tag fields are examples of such entitires. For these cases, + -- tag fields are examples of such entities. For these cases, -- we just test the type of the entity. if Present (Declaration_Node (Ent)) then @@ -5341,9 +5341,9 @@ package body Sem_Util is return False; end In_Instance_Visible_Part; - ---------------------- - -- In_Packiage_Body -- - ---------------------- + --------------------- + -- In_Package_Body -- + --------------------- function In_Package_Body return Boolean is S : Entity_Id; @@ -6616,7 +6616,7 @@ package body Sem_Util is Indx : Node_Id; begin - -- For private type, test corrresponding full type + -- For private type, test corresponding full type if Is_Private_Type (T) then return Is_Potentially_Persistent_Type (Full_View (T)); @@ -7482,7 +7482,7 @@ package body Sem_Util is when N_Type_Conversion => return Known_To_Be_Assigned (P); - -- All other references are definitely not knwon to be modifications + -- All other references are definitely not known to be modifications when others => return False; @@ -7611,7 +7611,7 @@ package body Sem_Util is when N_Type_Conversion => return May_Be_Lvalue (P); - -- Test for appearence in object renaming declaration + -- Test for appearance in object renaming declaration when N_Object_Renaming_Declaration => return True; @@ -8819,7 +8819,7 @@ package body Sem_Util is function Clear_Analyzed (N : Node_Id) return Traverse_Result; -- Function used to reset Analyzed flags in tree. Note that we do -- not reset Analyzed flags in entities, since there is no need to - -- renalalyze entities, and indeed, it is wrong to do so, since it + -- reanalyze entities, and indeed, it is wrong to do so, since it -- can result in generating auxiliary stuff more than once. -------------------- @@ -9707,7 +9707,7 @@ package body Sem_Util is Btyp := Root_Type (Btyp); - -- The accessibility level of anonymous acccess types associated with + -- The accessibility level of anonymous access types associated with -- discriminants is that of the current instance of the type, and -- that's deeper than the type itself (AARM 3.10.2 (12.3.21)). diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index c47af51cb12..519f574b2b3 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -438,7 +438,7 @@ package Sem_Util is Pos : Uint; Loc : Source_Ptr) return Entity_Id; -- This function obtains the E_Enumeration_Literal entity for the - -- specified value from the enumneration type or subtype T. The + -- specified value from the enumeration type or subtype T. The -- second argument is the Pos value, which is assumed to be in range. -- The third argument supplies a source location for constructed -- nodes returned by this function. @@ -547,7 +547,7 @@ package Sem_Util is -- initialize procedure, which makes the type not preelaborable. function Has_Preelaborable_Initialization (E : Entity_Id) return Boolean; - -- Return True iff type E has preelaborable initialiation as defined in + -- Return True iff type E has preelaborable initialisation as defined in -- Ada 2005 (see AI-161 for details of the definition of this attribute). function Has_Private_Component (Type_Id : Entity_Id) return Boolean; @@ -566,8 +566,8 @@ package Sem_Util is -- Returns True if Typ is a composite type (array or record) which is -- either itself a tagged type, or has a component (recursively) which is -- a tagged type. Returns False for non-composite type, or if no tagged - -- component is present. to check if '=' has to be expanded into a bunch - -- component comparisons. + -- component is present. This function is used to check if '=' has to be + -- expanded into a bunch component comparisons. function In_Instance return Boolean; -- Returns True if the current scope is within a generic instance @@ -690,7 +690,7 @@ package Sem_Util is -- i.e. a library unit or an entity declared in a library package. function Is_Local_Variable_Reference (Expr : Node_Id) return Boolean; - -- Determines whether Expr is a refeference to a variable or IN OUT + -- Determines whether Expr is a reference to a variable or IN OUT -- mode parameter of the current enclosing subprogram. -- Why are OUT parameters not considered here ??? @@ -747,7 +747,7 @@ package Sem_Util is function Is_Selector_Name (N : Node_Id) return Boolean; -- Given an N_Identifier node N, determines if it is a Selector_Name. -- As described in Sinfo, Selector_Names are special because they - -- represent use of the N_Identifier node for a true identifer, when + -- represent use of the N_Identifier node for a true identifier, when -- normally such nodes represent a direct name. function Is_Statement (N : Node_Id) return Boolean; @@ -795,14 +795,15 @@ package Sem_Util is -- entities in the current scope and in any parent scopes if the current -- scope is a block or a package (and that recursion continues to the top -- scope that is not a block or a package). This is used when the - -- sequential flow-of-control assumption is violated (occurence of a label, - -- head of a loop, or start of an exception handler). The effect of the - -- call is to clear the Constant_Value field (but we do not need to clear - -- the Is_True_Constant flag, since that only gets reset if there really is - -- an assignment somewhere in the entity scope). This procedure also calls - -- Kill_All_Checks, since this is a special case of needing to forget saved - -- values. This procedure also clears Is_Known_Non_Null flags in variables, - -- constants or parameters since these are also not known to be valid. + -- sequential flow-of-control assumption is violated (occurrence of a + -- label, head of a loop, or start of an exception handler). The effect of + -- the call is to clear the Constant_Value field (but we do not need to + -- clear the Is_True_Constant flag, since that only gets reset if there + -- really is an assignment somewhere in the entity scope). This procedure + -- also calls Kill_All_Checks, since this is a special case of needing to + -- forget saved values. This procedure also clears Is_Known_Non_Null flags + -- in variables, constants or parameters since these are also not known to + -- be valid. -- -- The Last_Assignment_Only flag is set True to clear only Last_Assignment -- fields and leave other fields unchanged. This is used when we encounter @@ -911,7 +912,7 @@ package Sem_Util is -- next entry of the Parameter_Associations list. The argument is an -- actual previously returned by a call to First_Actual or Next_Actual. -- Note that the result produced is always an expression, not a parameter - -- assciation node, even if named notation was used. + -- association node, even if named notation was used. procedure Normalize_Actuals (N : Node_Id; @@ -919,7 +920,7 @@ package Sem_Util is Report : Boolean; Success : out Boolean); -- Reorders lists of actuals according to names of formals, value returned - -- in Success indicates sucess of reordering. For more details, see body. + -- in Success indicates success of reordering. For more details, see body. -- Errors are reported only if Report is set to True. procedure Note_Possible_Modification (N : Node_Id; Sure : Boolean); @@ -1019,7 +1020,7 @@ package Sem_Util is function Same_Object (Node1, Node2 : Node_Id) return Boolean; -- Determine if Node1 and Node2 are known to designate the same object. - -- This is a semantic test and both nodesmust be fully analyzed. A result + -- This is a semantic test and both nodes must be fully analyzed. A result -- of True is decisively correct. A result of False does not necessarily -- mean that different objects are designated, just that this could not -- be reliably determined at compile time. diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index b9b81ab40ac..5fe97432e05 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -62,10 +62,10 @@ package body Sem_Warn is -- The following table collects potential warnings for IN OUT parameters -- that are referenced but not modified. These warnings are processed when - -- the front end calls the procedure Output_Non_Modifed_In_Out_Warnings. + -- the front end calls the procedure Output_Non_Modified_In_Out_Warnings. -- The reason that we defer output of these messages is that we want to -- detect the case where the relevant procedure is used as a generic actual - -- in an instantation, since we suppress the warnings in this case. The + -- in an instantiation, since we suppress the warnings in this case. The -- flag Used_As_Generic_Actual will be set in this case, but only at the -- point of usage. Similarly, we suppress the message if the address of the -- procedure is taken, where the flag Address_Taken may be set later. @@ -98,7 +98,7 @@ package body Sem_Warn is -- Instead the following is preferred - -- if somme-other-predicate-on-E + -- if some-other-predicate-on-E -- and then Has_Warnings_Off (E) -- This way if some-other-predicate is false, we avoid a false indication @@ -611,7 +611,7 @@ package body Sem_Warn is (E : Entity_Id; Accept_Statement : Node_Id) return Entity_Id; -- For an entry formal entity from an entry declaration, find the - -- corrsesponding body formal from the given accept statement. + -- corresponding body formal from the given accept statement. function Missing_Subunits return Boolean; -- We suppress warnings when there are missing subunits, because this @@ -1067,7 +1067,7 @@ package body Sem_Warn is -- actual, or its address/access is taken. In these two -- cases, we suppress the warning because the context may -- force use of IN OUT, even if in this particular case - -- the formal is not modifed. + -- the formal is not modified. else In_Out_Warnings.Append (E1); @@ -1174,7 +1174,7 @@ package body Sem_Warn is -- If the selected component comes from expansion, all -- we know is that the entity is not fully initialized -- at the point of the reference. Locate a random - -- unintialized component to get a better message. + -- uninitialized component to get a better message. elsif Nkind (Parent (UR)) = N_Selected_Component then Error_Msg_Node_2 := Selector_Name (Parent (UR)); @@ -1429,7 +1429,7 @@ package body Sem_Warn is end if; -- Recurse into nested package or block. Do not recurse into a - -- formal package, because the correponding body is not analyzed. + -- formal package, because the corresponding body is not analyzed. <> if ((Ekind (E1) = E_Package or else Ekind (E1) = E_Generic_Package) @@ -1539,7 +1539,7 @@ package body Sem_Warn is case Nkind (N) is - -- For identifier or exanded name, examine the entity involved + -- For identifier or expanded name, examine the entity involved when N_Identifier | N_Expanded_Name => declare @@ -1636,7 +1636,7 @@ package body Sem_Warn is function Process (N : Node_Id) return Traverse_Result; - -- Process function for instantation of Traverse + -- Process function for instantiation of Traverse -- below. Checks if N contains reference to other -- than a dereference. @@ -1882,7 +1882,7 @@ package body Sem_Warn is -- The only reference to a context unit may be in a renaming -- declaration. If this renaming declares a visible entity, do -- not warn that the context clause could be moved to the body, - -- because the renaming may be intented to re-export the unit. + -- because the renaming may be intended to re-export the unit. ------------------------- -- Check_Inner_Package -- @@ -2514,7 +2514,7 @@ package body Sem_Warn is end if; end No_Warn_On_In_Out; - -- Start of processing for Output_Non_Modifed_In_Out_Warnings + -- Start of processing for Output_Non_Modified_In_Out_Warnings begin -- Loop through entities for which a warning may be needed @@ -3292,7 +3292,7 @@ package body Sem_Warn is -- to this lower bound. If not, False is returned, and Low_Bound is -- undefined on return. -- - -- For now, we limite this to standard string types, so any other + -- For now, we limit this to standard string types, so any other -- unconstrained types return False. We may change our minds on this -- later on, but strings seem the most important case. @@ -3369,7 +3369,7 @@ package body Sem_Warn is begin -- Nothing to do if subscript does not come from source (we don't -- want to give garbage warnings on compiler expanded code, e.g. the - -- loops generated for slice assignments. Sucb junk warnings would + -- loops generated for slice assignments. Such junk warnings would -- be placed on source constructs with no subscript in sight!) if not Comes_From_Source (Original_Node (X)) then @@ -3411,7 +3411,7 @@ package body Sem_Warn is -- Tref (Sref) is used to scan the subscript Pctr : Natural; - -- Paretheses counter when scanning subscript + -- Parentheses counter when scanning subscript begin -- Tref (Sref) points to start of subscript @@ -3602,7 +3602,7 @@ package body Sem_Warn is Next_Formal (Form2); end loop; - -- Here all conditionas are met, record possible unset reference + -- Here all conditions are met, record possible unset reference Set_Unset_Reference (Form, Return_Node); end if; @@ -3631,7 +3631,7 @@ package body Sem_Warn is -- Case of variable that is assigned but not read. We suppress -- the message if the variable is volatile, has an address - -- clause, is aliasied, or is a renaming, or is imported. + -- clause, is aliased, or is a renaming, or is imported. if Referenced_As_LHS_Check_Spec (E) and then No (Address_Clause (E)) @@ -3879,7 +3879,7 @@ package body Sem_Warn is -- If we are not at the top level, we regard an inner -- exception handler as a decisive indicator that we should -- not generate the warning, since the variable in question - -- may be acceessed after an exception in the outer block. + -- may be accessed after an exception in the outer block. if Nkind (Parent (P)) /= N_Subprogram_Body and then Nkind (Parent (P)) /= N_Package_Body diff --git a/gcc/ada/sem_warn.ads b/gcc/ada/sem_warn.ads index d78bba96eca..e3daef471ab 100644 --- a/gcc/ada/sem_warn.ads +++ b/gcc/ada/sem_warn.ads @@ -169,7 +169,7 @@ package Sem_Warn is -- should be given for a possible infinite loop, and if so issues it. procedure Warn_On_Known_Condition (C : Node_Id); - -- C is a node for a boolean expression resluting from a relational + -- C is a node for a boolean expression resulting from a relational -- or membership operation. If the expression has a compile time known -- value, then a warning is output if all the following conditions hold: --