From: Arnaud Charlet Date: Thu, 7 Jul 2016 13:16:05 +0000 (+0200) Subject: [multiple changes] X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=8c519039a6363f0013d92f2e742adee4800806a0;p=gcc.git [multiple changes] 2016-07-07 Gary Dismukes * sem_ch3.adb, sem_prag.adb, sem_prag.ads, prj-ext.adb, freeze.adb, sem_attr.adb: Minor reformatting, fix typos. 2016-07-07 Justin Squirek * sem_ch12.adb (In_Same_Scope): Created this function to check a generic package definition against an instantiation for scope dependancies. (Install_Body): Add function In_Same_Scope and amend conditional in charge of delaying the package instance. (Is_In_Main_Unit): Add guard to check if parent is present in assignment of Current_Unit. From-SVN: r238115 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 711d888c6bd..1dea7dbf8fa 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,18 @@ +2016-07-07 Gary Dismukes + + * sem_ch3.adb, sem_prag.adb, sem_prag.ads, prj-ext.adb, freeze.adb, + sem_attr.adb: Minor reformatting, fix typos. + +2016-07-07 Justin Squirek + + * sem_ch12.adb (In_Same_Scope): Created this function to check + a generic package definition against an instantiation for scope + dependancies. + (Install_Body): Add function In_Same_Scope and + amend conditional in charge of delaying the package instance. + (Is_In_Main_Unit): Add guard to check if parent is present in + assignment of Current_Unit. + 2016-07-07 Eric Botcazou * sem_ch6.adb (Analyze_Subprogram_Body_Helper): Remove redundant test, diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 9b94fceb228..d5e8540c0c6 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -130,7 +130,7 @@ package body Freeze is procedure Check_Inherited_Conditions (R : Entity_Id); -- For a tagged derived type, create wrappers for inherited operations - -- that have a classwide condition, so it can be properly rewritten if + -- that have a class-wide condition, so it can be properly rewritten if -- it involves calls to other overriding primitives. procedure Check_Strict_Alignment (E : Entity_Id); @@ -1414,7 +1414,7 @@ package body Freeze is -- In SPARK mode this is where we can collect the inherited -- conditions, because we do not create the Check pragmas that - -- normally convey the the modified classwide conditions on + -- normally convey the the modified class-wide conditions on -- overriding operations. if SPARK_Mode = On then @@ -1451,14 +1451,14 @@ package body Freeze is A_Pre := Find_Aspect (Par_Prim, Aspect_Pre); if Present (A_Pre) and then Class_Present (A_Pre) then - Build_Classwide_Expression + Build_Class_Wide_Expression (Expression (A_Pre), Prim, Par_Prim, Adjust_Sloc => False); end if; A_Post := Find_Aspect (Par_Prim, Aspect_Post); if Present (A_Post) and then Class_Present (A_Post) then - Build_Classwide_Expression + Build_Class_Wide_Expression (Expression (A_Post), Prim, Par_Prim, Adjust_Sloc => False); end if; end if; @@ -4663,7 +4663,7 @@ package body Freeze is end if; -- For a derived tagged type, check whether inherited primitives - -- might require a wrapper to handle classwide conditions. + -- might require a wrapper to handle class-wide conditions. if Is_Tagged_Type (Rec) and then Is_Derived_Type (Rec) then Check_Inherited_Conditions (Rec); diff --git a/gcc/ada/prj-ext.adb b/gcc/ada/prj-ext.adb index 5f134008b1c..127438d8a24 100644 --- a/gcc/ada/prj-ext.adb +++ b/gcc/ada/prj-ext.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2016, 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- -- @@ -116,7 +116,7 @@ package body Prj.Ext is then if not Silent then Debug_Output - ("Not overridding existing external reference '" + ("Not overriding existing external reference '" & External_Name & "', value was defined in " & N.Source'Img); end if; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 3dec30ab0ed..c0be95d525a 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -3377,9 +3377,9 @@ package body Sem_Attr is P_Type := Underlying_Type (P_Type); end if; - -- Must have discriminants or be an access type designating - -- a type with discriminants. If it is a classwide type it - -- has unknown discriminants. + -- Must have discriminants or be an access type designating a type + -- with discriminants. If it is a class-wide type it has unknown + -- discriminants. if Has_Discriminants (P_Type) or else Has_Unknown_Discriminants (P_Type) @@ -5909,7 +5909,7 @@ package body Sem_Attr is else Error_Attr_P - ("prefix of% attribute must be remote access to classwide"); + ("prefix of% attribute must be remote access-to-class-wide"); end if; ---------- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index aecf7d4355d..0aa23ebc2cd 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -8939,8 +8939,9 @@ package body Sem_Ch12 is Must_Delay : Boolean; - function In_Same_Enclosing_Subp return Boolean; - -- Check whether instance and generic body are within same subprogram. + function In_Same_Scope (Generic_Id, Actual_Id : Node_Id) return Boolean; + -- Check if the generic definition's scope tree and the instantiation's + -- scope tree share a dependency. function True_Sloc (N : Node_Id) return Source_Ptr; -- If the instance is nested inside a generic unit, the Sloc of the @@ -8950,39 +8951,26 @@ package body Sem_Ch12 is -- origin of a node by finding the maximum sloc of any ancestor node. -- Why is this not equivalent to Top_Level_Location ??? - ---------------------------- - -- In_Same_Enclosing_Subp -- - ---------------------------- - - function In_Same_Enclosing_Subp return Boolean is - Scop : Entity_Id; - Subp : Entity_Id; + ------------------- + -- In_Same_Scope -- + ------------------- + function In_Same_Scope (Generic_Id, Actual_Id : Node_Id) return Boolean + is + Act_Scop : Entity_Id := Scope (Actual_Id); + Gen_Scop : Entity_Id := Scope (Generic_Id); begin - Scop := Scope (Act_Id); - while Scop /= Standard_Standard - and then not Is_Overloadable (Scop) + while Scope_Depth_Value (Act_Scop) > 0 + and then Scope_Depth_Value (Gen_Scop) > 0 loop - Scop := Scope (Scop); - end loop; - - if Scop = Standard_Standard then - return False; - else - Subp := Scop; - end if; - - Scop := Scope (Gen_Id); - while Scop /= Standard_Standard loop - if Scop = Subp then + if Act_Scop = Gen_Scop then return True; - else - Scop := Scope (Scop); end if; + Act_Scop := Scope (Act_Scop); + Gen_Scop := Scope (Gen_Scop); end loop; - return False; - end In_Same_Enclosing_Subp; + end In_Same_Scope; --------------- -- True_Sloc -- @@ -9071,9 +9059,8 @@ package body Sem_Ch12 is N_Generic_Package_Declaration) or else (Gen_Unit = Body_Unit and then True_Sloc (N) < Sloc (Orig_Body))) - and then Is_In_Main_Unit (Gen_Unit) - and then (Scope (Act_Id) = Scope (Gen_Id) - or else In_Same_Enclosing_Subp)); + and then Is_In_Main_Unit (Original_Node (Gen_Unit)) + and then (In_Same_Scope (Gen_Id, Act_Id))); -- If this is an early instantiation, the freeze node is placed after -- the generic body. Otherwise, if the generic appears in an instance, @@ -12901,6 +12888,7 @@ package body Sem_Ch12 is end if; Current_Unit := Parent (N); + while Present (Current_Unit) and then Nkind (Current_Unit) /= N_Compilation_Unit loop @@ -12915,7 +12903,8 @@ package body Sem_Ch12 is return Current_Unit = Cunit (Main_Unit) or else Current_Unit = Library_Unit (Cunit (Main_Unit)) - or else (Present (Library_Unit (Current_Unit)) + or else (Present (Current_Unit) + and then Present (Library_Unit (Current_Unit)) and then Is_In_Main_Unit (Library_Unit (Current_Unit))); end Is_In_Main_Unit; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 07fa54da0db..4053ead57d6 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -1415,7 +1415,7 @@ package body Sem_Ch3 is elsif Is_Class_Wide_Type (Full_Desig) and then Etype (Full_Desig) = T then Error_Msg_N - ("access type cannot designate its own classwide type", S); + ("access type cannot designate its own class-wide type", S); -- Clean up indication of tagged status to prevent cascaded errors @@ -4394,7 +4394,7 @@ package body Sem_Ch3 is -- type, rewrite the declaration as a renaming of the result of the -- call. The exceptions below are cases where the copy is expected, -- either by the back end (Aliased case) or by the semantics, as for - -- initializing controlled types or copying tags for classwide types. + -- initializing controlled types or copying tags for class-wide types. if Present (E) and then Nkind (E) = N_Explicit_Dereference @@ -16679,9 +16679,9 @@ package body Sem_Ch3 is Set_Ekind (Id, Ekind (Prev)); -- will be reset later Set_Class_Wide_Type (Id, Class_Wide_Type (Prev)); - -- The type of the classwide type is the current Id. Previously + -- Type of the class-wide type is the current Id. Previously -- this was not done for private declarations because of order- - -- of elaboration issues in the back-end, but gigi now handles + -- of-elaboration issues in the back end, but gigi now handles -- this properly. Set_Etype (Class_Wide_Type (Id), Id); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index bcdef91f143..9128294556f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -166,11 +166,11 @@ package body Sem_Prag is Table_Increment => 100, Table_Name => "Name_Externals"); - -------------------------------------------------------- - -- Handling of inherited classwide pre/postconditions -- - -------------------------------------------------------- + --------------------------------------------------------- + -- Handling of inherited class-wide pre/postconditions -- + --------------------------------------------------------- - -- Following AI12-0113, the expression for a classwide condition is + -- Following AI12-0113, the expression for a class-wide condition is -- transformed for a subprogram that inherits it, by replacing calls -- to primitive operations of the original controlling type into the -- corresponding overriding operations of the derived type. The following @@ -20339,7 +20339,7 @@ package body Sem_Prag is else Error_Pragma_Arg - ("pragma% applies only to formal access to classwide types", + ("pragma% applies only to formal access-to-class-wide types", Arg1); end if; end Remote_Access_Type; @@ -26401,11 +26401,11 @@ package body Sem_Prag is return False; end Appears_In; - -------------------------------- - -- Build_Classwide_Expression -- - -------------------------------- + --------------------------------- + -- Build_Class_Wide_Expression -- + --------------------------------- - procedure Build_Classwide_Expression + procedure Build_Class_Wide_Expression (Prag : Node_Id; Subp : Entity_Id; Par_Subp : Entity_Id; @@ -26417,7 +26417,7 @@ package body Sem_Prag is 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, - -- when constructing the classwide condition of an overridding + -- when constructing the class-wide condition of an overriding -- subprogram. -------------------- @@ -26516,10 +26516,10 @@ package body Sem_Prag is procedure Replace_Condition_Entities is new Traverse_Proc (Replace_Entity); - -- Start of processing for Build_Classwide_Expression + -- Start of processing for Build_Class_Wide_Expression begin - -- Add mapping from old formals to new formals. + -- Add mapping from old formals to new formals Par_Formal := First_Formal (Par_Subp); Subp_Formal := First_Formal (Subp); @@ -26531,7 +26531,7 @@ package body Sem_Prag is end loop; Replace_Condition_Entities (Prag); - end Build_Classwide_Expression; + end Build_Class_Wide_Expression; ----------------------------------- -- Build_Pragma_Check_Equivalent -- @@ -26608,9 +26608,9 @@ package body Sem_Prag is (Unit_Declaration_Node (Subp_Id), Inher_Id); Check_Prag := New_Copy_Tree (Source => Prag); - -- Build the inherited classwide condition. + -- Build the inherited class-wide condition - Build_Classwide_Expression + Build_Class_Wide_Expression (Check_Prag, Subp_Id, Inher_Id, Adjust_Sloc => True); -- If not an inherited condition simply copy the original pragma diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index 16ff72dc2da..c442d55246a 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -244,21 +244,21 @@ package Sem_Prag is procedure Analyze_Test_Case_In_Decl_Part (N : Node_Id); -- Perform preanalysis of pragma Test_Case - procedure Build_Classwide_Expression + procedure Build_Class_Wide_Expression (Prag : Node_Id; Subp : Entity_Id; Par_Subp : Entity_Id; Adjust_Sloc : Boolean); - -- Build the expression for an inherited classwide condition. Prag is + -- Build the expression for an inherited class-wide condition. Prag is -- the pragma constructed from the corresponding aspect of the parent - -- subprogram, and Subp is the overridding operation and Par_Subp is + -- subprogram, and Subp is the overriding operation and Par_Subp is -- the overridden operation that has the condition. Adjust_Sloc is True -- when the sloc of nodes traversed should be adjusted for the inherited -- pragma. The routine is also called to check whether an inherited -- operation that is not overridden but has inherited conditions need -- a wrapper, because the inherited condition includes calls to other -- primitives that have been overridden. In that case the first argument - -- is the expression of the original classwide aspect. In SPARK_Mode, such + -- is the expression of the original class-wide aspect. In SPARK_Mode, such -- operation which are just inherited but have modified pre/postconditions -- are illegal.