From 0d6014fad7a26ba4cbfc27acaa3ec977c457c0ae Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 18 Apr 2016 12:19:26 +0200 Subject: [PATCH] [multiple changes] 2016-04-18 Eric Botcazou * layout.adb: Fix more minor typos in comments. 2016-04-18 Hristian Kirtchev * a-calend.ads, sem_prag.adb, sem_ch6.adb: Minor reformatting. From-SVN: r235114 --- gcc/ada/ChangeLog | 8 ++ gcc/ada/a-calend.ads | 3 +- gcc/ada/layout.adb | 30 +++--- gcc/ada/sem_ch6.adb | 6 +- gcc/ada/sem_prag.adb | 227 +++++++++++++++++++++++-------------------- 5 files changed, 147 insertions(+), 127 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3e329a87b49..e59b0672df3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2016-04-18 Eric Botcazou + + * layout.adb: Fix more minor typos in comments. + +2016-04-18 Hristian Kirtchev + + * a-calend.ads, sem_prag.adb, sem_ch6.adb: Minor reformatting. + 2016-04-18 Ed Schonberg * sem_ch6.adb (Analyze_Subprogram_Body_Helper): In GNATprove diff --git a/gcc/ada/a-calend.ads b/gcc/ada/a-calend.ads index 0eed8badf49..d7651037c79 100644 --- a/gcc/ada/a-calend.ads +++ b/gcc/ada/a-calend.ads @@ -115,8 +115,9 @@ is Time_Error : exception; private - -- Mark private part as SPARK_Mode Off to avoid accounting for variable + -- Mark the private part as SPARK_Mode Off to avoid accounting for variable -- Invalid_Time_Zone_Offset in abstract state. + pragma SPARK_Mode (Off); pragma Inline (Clock); diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index cee5853fcf2..97c653c0f0d 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -3247,7 +3247,7 @@ package body Layout is A := 2 * A; end loop; - -- If alignment is currently not set, then we can safetly set it to + -- If alignment is currently not set, then we can safely set it to -- this new calculated value. if Unknown_Alignment (E) then @@ -3256,7 +3256,7 @@ package body Layout is -- Cases where we have inherited an alignment -- For constructed types, always reset the alignment, these are - -- Generally invisible to the user anyway, and that way we are + -- generally invisible to the user anyway, and that way we are -- sure that no constructed types have weird alignments. elsif not Comes_From_Source (E) then @@ -3282,23 +3282,23 @@ package body Layout is -- It seems quite bogus in this case to inherit an alignment of 1 -- from the parent type Character. Furthermore, if that's what the - -- programmer really wanted for some odd reason, then they could - -- specify the alignment they wanted. + -- programmer really wanted for some odd reason, then he could + -- specify the alignment directly. -- Furthermore we really don't want to inherit the alignment in -- the case of a specified Object_Size for a subtype, since then -- there would be no way of overriding to give a reasonable value -- (we don't have an Object_Subtype attribute). Consider: - -- subtype R is new Character; + -- subtype R is Character; -- for R'Object_Size use 16; - -- If we inherit the alignment of 1, then we have an odd - -- inefficient alignment for the subtype, which cannot be fixed. + -- If we inherit the alignment of 1, then we have an inefficient + -- alignment for the subtype, which cannot be fixed. -- So we make the decision that if Size (or Object_Size) is given -- (and, in the case of a first subtype, the alignment is not set - -- with a specific alignment clause). We reset the alignment to + -- with a specific alignment clause), we reset the alignment to -- the appropriate value for the specified size. This is a nice -- simple rule to implement and document. @@ -3311,15 +3311,15 @@ package body Layout is -- type S is new R; -- for S'Size use Character'Size; - -- Now the alignment of S is 1 instead of 2, as a result of - -- applying the above rule to the confirming rep clause for S. Not - -- clear this is worth worrying about. If we recorded whether a - -- size clause was confirming we could avoid this, but right now + -- Now the alignment of S is changed to 1 instead of 2 as a result + -- of applying the above rule to the confirming rep clause for S. + -- Not clear this is worth worrying about. If we recorded whether + -- a size clause was confirming we could avoid this, but right now -- we have no way of doing that or easily figuring it out, so we -- don't bother. - -- Historical note. In versions of GNAT prior to Nov 6th, 2011, an - -- odd distinction was made between inherited alignments greater + -- Historical note: in versions of GNAT prior to Nov 6th, 2011, an + -- odd distinction was made between inherited alignments larger -- than the computed alignment (where the larger alignment was -- inherited) and inherited alignments smaller than the computed -- alignment (where the smaller alignment was overridden). This @@ -3337,7 +3337,7 @@ package body Layout is -- for R'Alignment use 1; -- subtype S is R; - -- Here we have R has a default Object_Size of 32, and a specified + -- Here we have R with a default Object_Size of 32, and a specified -- alignment of 1, and it seeems right for S to inherit both values. else diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index c1e57471c79..437ca141954 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -3754,9 +3754,9 @@ package body Sem_Ch6 is Build_Body_To_Inline (N, Spec_Id); end if; - -- When generating code, inherited pre/postconditions are handled - -- when expanding the corresponding contract. If GNATprove mode we - -- must process them when the body is analyzed. + -- When generating code, inherited pre/postconditions are handled when + -- expanding the corresponding contract. In GNATprove the annotations + -- must be processed when the body is analyzed. if GNATprove_Mode and then Present (Spec_Id) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 01f498847bf..46a30390c86 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -23198,8 +23198,8 @@ package body Sem_Prag is if Class_Present (N) then - -- Verify that a class-wide condition is legal, i.e. the operation - -- is a primitive of a tagged type. + -- Verify that a class-wide condition is legal, i.e. the operation is + -- a primitive of a tagged type. Disp_Typ := Find_Dispatching_Type (Spec_Id); @@ -26045,61 +26045,32 @@ package body Sem_Prag is Subp_Id : Entity_Id := Empty; Inher_Id : Entity_Id := Empty) return Node_Id is + Map : Elist_Id; + -- List containing the following mappings + -- * Formal parameters of inherited subprogram Inher_Id and subprogram + -- Subp_Id. + -- + -- * The dispatching type of Inher_Id and the dispatching type of + -- Subp_Id. + -- + -- * Primitives of the dispatching type of Inher_Id and primitives of + -- the dispatching type of Subp_Id. + + function Replace_Entity (N : Node_Id) return Traverse_Result; + -- Replace reference to formal of inherited operation or to primitive + -- operation of root type, with corresponding entity for derived type. + function Suppress_Reference (N : Node_Id) return Traverse_Result; -- Detect whether node N references a formal parameter subject to -- pragma Unreferenced. If this is the case, set Comes_From_Source -- to False to suppress the generation of a reference when analyzing -- N later on. - ------------------------ - -- Suppress_Reference -- - ------------------------ - - function Suppress_Reference (N : Node_Id) return Traverse_Result is - Formal : Entity_Id; - - begin - if Is_Entity_Name (N) and then Present (Entity (N)) then - Formal := Entity (N); - - -- The formal parameter is subject to pragma Unreferenced. - -- Prevent the generation of a reference by resetting the - -- Comes_From_Source flag. - - if Is_Formal (Formal) - and then Has_Pragma_Unreferenced (Formal) - then - Set_Comes_From_Source (N, False); - end if; - end if; - - return OK; - end Suppress_Reference; - - procedure Suppress_References is - new Traverse_Proc (Suppress_Reference); - - -- Local variables - - Loc : constant Source_Ptr := Sloc (Prag); - Prag_Nam : constant Name_Id := Pragma_Name (Prag); - Check_Prag : Node_Id; - Formals_Map : Elist_Id; - Inher_Formal : Entity_Id; - Msg_Arg : Node_Id; - Nam : Name_Id; - Subp_Formal : Entity_Id; - - function Replace_Entity (N : Node_Id) return Traverse_Result; - -- Replace reference to formal of inherited operation or to primitive - -- operation of root type, with corresponding entity for derived type. - -------------------- -- Replace_Entity -- -------------------- - function Replace_Entity (N : Node_Id) return Traverse_Result - is + function Replace_Entity (N : Node_Id) return Traverse_Result is Elmt : Elmt_Id; New_E : Entity_Id; @@ -26112,9 +26083,9 @@ package body Sem_Prag is (Nkind (Parent (N)) /= N_Attribute_Reference or else Attribute_Name (Parent (N)) /= Name_Class) then - -- The replacement does not apply to dispatching calls within - -- the condition, but only to calls whose static tag is that - -- of the parent type. + -- The replacement does not apply to dispatching calls within the + -- condition, but only to calls whose static tag is that of the + -- parent type. if Is_Subprogram (Entity (N)) and then Nkind (Parent (N)) = N_Function_Call @@ -26126,7 +26097,7 @@ package body Sem_Prag is -- Loop to find out if entity has a renaming New_E := Empty; - Elmt := First_Elmt (Formals_Map); + Elmt := First_Elmt (Map); while Present (Elmt) loop if Node (Elmt) = Entity (N) then New_E := Node (Next_Elmt (Elmt)); @@ -26142,7 +26113,7 @@ package body Sem_Prag is end if; if not Is_Abstract_Subprogram (Inher_Id) - and then Nkind (N) = N_Function_Call + and then Nkind (N) = N_Function_Call and then Present (Entity (Name (N))) and then Is_Abstract_Subprogram (Entity (Name (N))) then @@ -26157,99 +26128,139 @@ package body Sem_Prag is return OK; end Replace_Entity; + ------------------------ + -- Suppress_Reference -- + ------------------------ + + function Suppress_Reference (N : Node_Id) return Traverse_Result is + Formal : Entity_Id; + + begin + if Is_Entity_Name (N) and then Present (Entity (N)) then + Formal := Entity (N); + + -- The formal parameter is subject to pragma Unreferenced. + -- Prevent the generation of a reference by resetting the + -- Comes_From_Source flag. + + if Is_Formal (Formal) + and then Has_Pragma_Unreferenced (Formal) + then + Set_Comes_From_Source (N, False); + end if; + end if; + + return OK; + end Suppress_Reference; + procedure Replace_Condition_Entities is new Traverse_Proc (Replace_Entity); + procedure Suppress_References is + new Traverse_Proc (Suppress_Reference); + + -- Local variables + + Loc : constant Source_Ptr := Sloc (Prag); + Prag_Nam : constant Name_Id := Pragma_Name (Prag); + Check_Prag : Node_Id; + Inher_Formal : Entity_Id; + Msg_Arg : Node_Id; + Nam : Name_Id; + Subp_Formal : Entity_Id; + -- Start of processing for Build_Pragma_Check_Equivalent begin - Formals_Map := No_Elist; + Map := No_Elist; - -- When the pre- or postcondition is inherited, map the formals of - -- the inherited subprogram to those of the current subprogram. - -- In addition, map primitive operations of the parent type into the - -- corresponding primitive operations of the descendant. + -- When the pre- or postcondition is inherited, map the formals of the + -- inherited subprogram to those of the current subprogram. In addition, + -- map primitive operations of the parent type into the corresponding + -- primitive operations of the descendant. if Present (Inher_Id) then pragma Assert (Present (Subp_Id)); - Formals_Map := New_Elmt_List; + Map := New_Elmt_List; -- Create a mapping => Inher_Formal := First_Formal (Inher_Id); Subp_Formal := First_Formal (Subp_Id); while Present (Inher_Formal) and then Present (Subp_Formal) loop - Append_Elmt (Inher_Formal, Formals_Map); - Append_Elmt (Subp_Formal, Formals_Map); + Append_Elmt (Inher_Formal, Map); + Append_Elmt (Subp_Formal, Map); Next_Formal (Inher_Formal); Next_Formal (Subp_Formal); end loop; - -- Map primitive operations of the parent type into the corresponding - -- operations of the descendant. The descendant type might not be - -- frozen yet, so we cannot use the dispatch table directly. + -- Map primitive operations of the parent type to the corresponding + -- operations of the descendant. Note that the descendant type may + -- not be frozen yet, so we cannot use the dispatch table directly. declare - T : constant Entity_Id := Find_Dispatching_Type (Subp_Id); - Old_T : constant Entity_Id := Find_Dispatching_Type (Inher_Id); - D : Node_Id; - E : Entity_Id; - Old_E : Entity_Id; + Old_Typ : constant Entity_Id := Find_Dispatching_Type (Inher_Id); + Typ : constant Entity_Id := Find_Dispatching_Type (Subp_Id); + Decl : Node_Id; + Old_Prim : Entity_Id; + Prim : Entity_Id; begin - D := First (List_Containing (Unit_Declaration_Node (Subp_Id))); + Decl := First (List_Containing (Unit_Declaration_Node (Subp_Id))); -- Look for primitive operations of the current type that have -- overridden an operation of the type related to the original -- class-wide precondition. There may be several intermediate -- overridings between them. - while Present (D) loop - if Nkind (D) = N_Subprogram_Declaration then - E := Defining_Entity (D); - if Is_Subprogram (E) - and then Present (Overridden_Operation (E)) - and then Find_Dispatching_Type (E) = T + while Present (Decl) loop + if Nkind (Decl) = N_Subprogram_Declaration then + Prim := Defining_Entity (Decl); + + if Is_Subprogram (Prim) + and then Present (Overridden_Operation (Prim)) + and then Find_Dispatching_Type (Prim) = Typ then - Old_E := Overridden_Operation (E); - while Present (Overridden_Operation (Old_E)) - and then Scope (Old_E) /= Scope (Inher_Id) + Old_Prim := Overridden_Operation (Prim); + while Present (Overridden_Operation (Old_Prim)) + and then Scope (Old_Prim) /= Scope (Inher_Id) loop - Old_E := Overridden_Operation (Old_E); + Old_Prim := Overridden_Operation (Old_Prim); end loop; - Append_Elmt (Old_E, Formals_Map); - Append_Elmt (E, Formals_Map); + Append_Elmt (Old_Prim, Map); + Append_Elmt (Prim, Map); end if; end if; - Next (D); + Next (Decl); end loop; - E := First_Entity (Scope (Subp_Id)); - while Present (E) loop - if not Comes_From_Source (E) - and then Ekind (E) = E_Function - and then Present (Alias (E)) + Prim := First_Entity (Scope (Subp_Id)); + while Present (Prim) loop + if not Comes_From_Source (Prim) + and then Ekind (Prim) = E_Function + and then Present (Alias (Prim)) then - Old_E := Alias (E); - while Present (Alias (Old_E)) - and then Scope (Old_E) /= Scope (Inher_Id) + Old_Prim := Alias (Prim); + while Present (Alias (Old_Prim)) + and then Scope (Old_Prim) /= Scope (Inher_Id) loop - Old_E := Alias (Old_E); + Old_Prim := Alias (Old_Prim); end loop; - Append_Elmt (Old_E, Formals_Map); - Append_Elmt (E, Formals_Map); + Append_Elmt (Old_Prim, Map); + Append_Elmt (Prim, Map); end if; - Next_Entity (E); + + Next_Entity (Prim); end loop; - if Formals_Map /= No_Elist then - Append_Elmt (Old_T, Formals_Map); - Append_Elmt (T, Formals_Map); + if Map /= No_Elist then + Append_Elmt (Old_Typ, Map); + Append_Elmt (Typ, Map); end if; end; end if; @@ -26257,14 +26268,14 @@ package body Sem_Prag is -- Copy the original pragma while performing substitutions (if -- applicable). - Check_Prag := New_Copy_Tree (Source => Prag); + Check_Prag := New_Copy_Tree (Source => Prag); - if Formals_Map /= No_Elist then + if Map /= No_Elist then Replace_Condition_Entities (Check_Prag); end if; - -- Mark the pragma as being internally generated and reset the - -- Analyzed flag. + -- Mark the pragma as being internally generated and reset the Analyzed + -- flag. Set_Analyzed (Check_Prag, False); Set_Comes_From_Source (Check_Prag, False); @@ -26294,8 +26305,8 @@ package body Sem_Prag is Nam := Prag_Nam; end if; - -- Convert the copy into pragma Check by correcting the name and - -- adding a check_kind argument. + -- Convert the copy into pragma Check by correcting the name and adding + -- a check_kind argument. Set_Pragma_Identifier (Check_Prag, Make_Identifier (Loc, Name_Check)); @@ -26795,7 +26806,7 @@ package body Sem_Prag is Bod : Node_Id) is Parent_Subp : constant Entity_Id := Overridden_Operation (Subp); - Prags : constant Node_Id := Contract (Parent_Subp); + Prags : constant Node_Id := Contract (Parent_Subp); Prag : Node_Id; begin @@ -26806,15 +26817,15 @@ package body Sem_Prag is Prag := Pre_Post_Conditions (Prags); while Present (Prag) loop - if Pragma_Name (Prag) = Name_Precondition - or else Pragma_Name (Prag) = Name_Postcondition + if Nam_In (Pragma_Name (Prag), Name_Precondition, + Name_Postcondition) then if No (Declarations (Bod)) then Set_Declarations (Bod, Empty_List); end if; - Append (Build_Pragma_Check_Equivalent (Prag, Subp, Parent_Subp), - To => Declarations (Bod)); + Append_To (Declarations (Bod), + Build_Pragma_Check_Equivalent (Prag, Subp, Parent_Subp)); end if; Prag := Next_Pragma (Prag); -- 2.30.2