From 6fdc25c4a37d71887bbde1738523d6880eeae50b Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 2 May 2017 10:39:29 +0200 Subject: [PATCH] [multiple changes] 2017-05-02 Ed Schonberg * sem_ch4.adb (Find_Equality_Types, Try_One_Interp): The same relaxed visibility rules for equality operators that apply within an instantiation apply within an inlined body. * sem_type.adb (Add_One_Interp): ditto. 2017-05-02 Hristian Kirtchev * sem_prag.adb (Analyze_Pragma): Forbid pragma Contract_Cases on null procedures. 2017-05-02 Eric Botcazou * snames.ads-tmpl (Name_Assume, Name_Attribute_Definition, Name_Loop_Optimize, Name_No_Tagged_Streams): Move to regular pragmas. Add placeholders for Default_Scalar_Storage_Order, Dispatching_Domain, and Secondary_Stack_Size. (Pragma_Id): Move Pragma_Assume, Pragma_Attribute_Definition, Pragma_Loop_Optimize and Pragma_No_Tagged_Streams to second part. From-SVN: r247470 --- gcc/ada/ChangeLog | 23 ++++++++++++ gcc/ada/sem_ch4.adb | 2 +- gcc/ada/sem_prag.adb | 15 +++++++- gcc/ada/sem_type.adb | 2 +- gcc/ada/snames.ads-tmpl | 80 ++++++++++++++++++++++------------------- 5 files changed, 83 insertions(+), 39 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f1754d8723b..fb54ab70c2c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,26 @@ +2017-05-02 Ed Schonberg + + * sem_ch4.adb (Find_Equality_Types, Try_One_Interp): The same relaxed + visibility rules for equality operators that apply within an + instantiation apply within an inlined body. + * sem_type.adb (Add_One_Interp): ditto. + +2017-05-02 Hristian Kirtchev + + * sem_prag.adb (Analyze_Pragma): Forbid pragma Contract_Cases on null + procedures. + +2017-05-02 Eric Botcazou + + * snames.ads-tmpl + (Name_Assume, Name_Attribute_Definition, Name_Loop_Optimize, + Name_No_Tagged_Streams): Move to regular pragmas. Add + placeholders for Default_Scalar_Storage_Order, Dispatching_Domain, + and Secondary_Stack_Size. + (Pragma_Id): Move Pragma_Assume, + Pragma_Attribute_Definition, Pragma_Loop_Optimize and + Pragma_No_Tagged_Streams to second part. + 2017-05-02 Hristian Kirtchev * exp_attr.adb: Minor reformatting. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 12f930df698..9a22b8eb32d 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -6476,7 +6476,7 @@ package body Sem_Ch4 is -- Either the types are compatible, or one operand is universal -- (numeric or null). - or else (In_Instance + or else ((In_Instance or else In_Inlined_Body) and then (First_Subtype (T1) = First_Subtype (Etype (R)) or else Nkind (R) = N_Null diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 1c3acec4103..e19535fed1c 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -13422,6 +13422,7 @@ package body Sem_Prag is when Pragma_Contract_Cases => Contract_Cases : declare Spec_Id : Entity_Id; Subp_Decl : Node_Id; + Subp_Spec : Node_Id; begin GNAT_Pragma; @@ -13462,7 +13463,19 @@ package body Sem_Prag is -- Subprogram elsif Nkind (Subp_Decl) = N_Subprogram_Declaration then - null; + Subp_Spec := Specification (Subp_Decl); + + -- Pragma Contract_Cases is forbidden on null procedures, as + -- this may lead to potential ambiguities in behavior when + -- interface null procedures are involved. + + if Nkind (Subp_Spec) = N_Procedure_Specification + and then Null_Present (Subp_Spec) + then + Error_Msg_N (Fix_Error + ("pragma % cannot apply to null procedure"), N); + return; + end if; else Pragma_Misplaced; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 1e5199dc403..b77b538716e 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -374,7 +374,7 @@ package body Sem_Type is and then not Is_Hidden (Vis_Type)) or else Nkind (N) = N_Expanded_Name or else (Nkind (N) in N_Op and then E = Entity (N)) - or else In_Instance + or else (In_Instance or else In_Inlined_Body) or else Ekind (Vis_Type) = E_Anonymous_Access_Type then null; diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl index 2d49322e982..cdf2ca66e95 100644 --- a/gcc/ada/snames.ads-tmpl +++ b/gcc/ada/snames.ads-tmpl @@ -379,8 +379,8 @@ package Snames is First_Pragma_Name : constant Name_Id := N + $; -- Configuration pragmas are grouped at start. Note that there is a list - -- of these names in the GNAT Users guide, be sure to update this list if - -- a new configuration pragma is added. + -- of them in the GNAT UG (doc/gnat_ugn/the_gnat_compilation_model.rst), + -- be sure to update this list if a new configuration pragma is added. Name_Ada_83 : constant Name_Id := N + $; -- GNAT Name_Ada_95 : constant Name_Id := N + $; -- GNAT @@ -391,9 +391,7 @@ package Snames is Name_Allow_Integer_Address : constant Name_Id := N + $; -- GNAT Name_Annotate : constant Name_Id := N + $; -- GNAT Name_Assertion_Policy : constant Name_Id := N + $; -- Ada 05 - Name_Assume : constant Name_Id := N + $; -- GNAT Name_Assume_No_Invalid_Values : constant Name_Id := N + $; -- GNAT - Name_Attribute_Definition : constant Name_Id := N + $; -- GNAT Name_C_Pass_By_Copy : constant Name_Id := N + $; -- GNAT Name_Check_Float_Overflow : constant Name_Id := N + $; -- GNAT Name_Check_Name : constant Name_Id := N + $; -- GNAT @@ -406,16 +404,15 @@ package Snames is Name_Convention_Identifier : constant Name_Id := N + $; -- GNAT Name_Debug_Policy : constant Name_Id := N + $; -- GNAT Name_Detect_Blocking : constant Name_Id := N + $; -- Ada 05 + + -- Note: Default_Scalar_Storage_Order is not in this list because its name + -- matches the name of the corresponding attribute. However, it is included + -- in the definition of the type Pragma_Id, and the functions Get_Pragma_Id + -- and Is_Pragma_Name correctly recognize Default_Scalar_Storage_Order. + Name_Default_Storage_Pool : constant Name_Id := N + $; -- Ada 12 Name_Disable_Atomic_Synchronization : constant Name_Id := N + $; -- GNAT Name_Discard_Names : constant Name_Id := N + $; - - -- Note: Dispatching_Domain is not in this list because its name matches - -- the name of the corresponding attribute. However, it is included in the - -- definition of the type Pragma_Id, and the functions Get_Pragma_Id and - -- Is_Pragma_Id correctly recognize and process Dispatching_Domain. - -- Dispatching_Domain is a standard Ada 2012 pragma. - Name_Elaboration_Checks : constant Name_Id := N + $; -- GNAT Name_Eliminate : constant Name_Id := N + $; -- GNAT Name_Enable_Atomic_Synchronization : constant Name_Id := N + $; -- GNAT @@ -425,9 +422,8 @@ package Snames is -- Note: Fast_Math is not in this list because its name matches the name of -- the corresponding attribute. However, it is included in the definition - -- of the type Pragma_Id, and the functions Get_Pragma_Id, - -- Is_[Configuration_]Pragma_Id, and correctly recognize and process - -- Fast_Math. + -- of the type Pragma_Id and the functions Get_Pragma_Id and Is_Pragma_Name + -- correctly recognize and process Fast_Math. Name_Favor_Top_Level : constant Name_Id := N + $; -- GNAT Name_Ignore_Pragma : constant Name_Id := N + $; -- GNAT @@ -436,11 +432,9 @@ package Snames is Name_Interrupt_State : constant Name_Id := N + $; -- GNAT Name_License : constant Name_Id := N + $; -- GNAT Name_Locking_Policy : constant Name_Id := N + $; - Name_Loop_Optimize : constant Name_Id := N + $; -- GNAT Name_No_Heap_Finalization : constant Name_Id := N + $; -- GNAT Name_No_Run_Time : constant Name_Id := N + $; -- GNAT Name_No_Strict_Aliasing : constant Name_Id := N + $; -- GNAT - Name_No_Tagged_Streams : constant Name_Id := N + $; -- GNAT Name_Normalize_Scalars : constant Name_Id := N + $; Name_Optimize_Alignment : constant Name_Id := N + $; -- GNAT Name_Overflow_Mode : constant Name_Id := N + $; -- GNAT @@ -487,12 +481,14 @@ package Snames is Name_All_Calls_Remote : constant Name_Id := N + $; Name_Assert : constant Name_Id := N + $; -- Ada 05 Name_Assert_And_Cut : constant Name_Id := N + $; -- GNAT + Name_Assume : constant Name_Id := N + $; -- GNAT Name_Async_Readers : constant Name_Id := N + $; -- GNAT Name_Async_Writers : constant Name_Id := N + $; -- GNAT Name_Asynchronous : constant Name_Id := N + $; Name_Atomic : constant Name_Id := N + $; Name_Atomic_Components : constant Name_Id := N + $; Name_Attach_Handler : constant Name_Id := N + $; + Name_Attribute_Definition : constant Name_Id := N + $; -- GNAT Name_Check : constant Name_Id := N + $; -- GNAT Name_Comment : constant Name_Id := N + $; -- GNAT Name_Common_Object : constant Name_Id := N + $; -- GNAT @@ -509,14 +505,20 @@ package Snames is -- Note: CPU is not in this list because its name matches the name of -- the corresponding attribute. However, it is included in the definition - -- of the type Pragma_Id, and the functions Get_Pragma_Id and Is_Pragma_Id - -- correctly recognize and process CPU. CPU is a standard Ada 2012 - -- pragma. + -- of the type Pragma_Id and the functions Get_Pragma_Id and Is_Pragma_Name + -- correctly recognize and process CPU. CPU is a standard Ada 2012 pragma. Name_Deadline_Floor : constant Name_Id := N + $; -- GNAT Name_Debug : constant Name_Id := N + $; -- GNAT Name_Default_Initial_Condition : constant Name_Id := N + $; -- GNAT Name_Depends : constant Name_Id := N + $; -- GNAT + + -- Note: Dispatching_Domain is not in this list because its name matches + -- the name of the corresponding attribute. However, it is included in the + -- definition of the type Pragma_Id, and the functions Get_Pragma_Id and + -- Is_Pragma_Name correctly recognize and process Dispatching_Domain. + -- Dispatching_Domain is a standard Ada 2012 pragma. + Name_Effective_Reads : constant Name_Id := N + $; -- GNAT Name_Effective_Writes : constant Name_Id := N + $; -- GNAT Name_Elaborate : constant Name_Id := N + $; -- Ada 83 @@ -551,9 +553,9 @@ package Snames is Name_Inspection_Point : constant Name_Id := N + $; -- Note: Interface is not in this list because its name matches an Ada 05 - -- keyword. However it is included in the definition of the type - -- Attribute_Id, and the functions Get_Pragma_Id and Is_Pragma_Id correctly - -- recognize and process Name_Interface. + -- keyword. However it is included in the definition of the type Pragma_Id, + -- and the functions Get_Pragma_Id and Is_Pragma_Name correctly recognize + -- and process Name_Interface. Name_Interface_Name : constant Name_Id := N + $; -- GNAT Name_Interrupt_Handler : constant Name_Id := N + $; @@ -561,7 +563,7 @@ package Snames is -- Note: Interrupt_Priority is not in this list because its name matches -- the name of the corresponding attribute. However, it is included in the -- definition of the type Pragma_Id, and the functions Get_Pragma_Id and - -- Is_Pragma_Id correctly recognize and process Interrupt_Priority. + -- Is_Pragma_Name correctly recognize and process Interrupt_Priority. Name_Invariant : constant Name_Id := N + $; -- GNAT Name_Keep_Names : constant Name_Id := N + $; -- GNAT @@ -575,10 +577,11 @@ package Snames is -- Note: Lock_Free is not in this list because its name matches the name of -- the corresponding attribute. However, it is included in the definition - -- of the type Pragma_Id, and the functions Get_Pragma_Id and Is_Pragma_Id + -- of the type Pragma_Id and the functions Get_Pragma_Id and Is_Pragma_Name -- correctly recognize and process Lock_Free. Lock_Free is a GNAT pragma. Name_Loop_Invariant : constant Name_Id := N + $; -- GNAT + Name_Loop_Optimize : constant Name_Id := N + $; -- GNAT Name_Loop_Variant : constant Name_Id := N + $; -- GNAT Name_Machine_Attribute : constant Name_Id := N + $; -- GNAT Name_Main : constant Name_Id := N + $; -- GNAT @@ -589,6 +592,7 @@ package Snames is Name_No_Elaboration_Code_All : constant Name_Id := N + $; -- GNAT Name_No_Inline : constant Name_Id := N + $; -- GNAT Name_No_Return : constant Name_Id := N + $; -- Ada 05 + Name_No_Tagged_Streams : constant Name_Id := N + $; -- GNAT Name_Obsolescent : constant Name_Id := N + $; -- GNAT Name_Optimize : constant Name_Id := N + $; Name_Ordered : constant Name_Id := N + $; -- GNAT @@ -609,7 +613,7 @@ package Snames is -- Note: Priority is not in this list because its name matches the name of -- the corresponding attribute. However, it is included in the definition - -- of the type Pragma_Id, and the functions Get_Pragma_Id and Is_Pragma_Id + -- of the type Pragma_Id and the functions Get_Pragma_Id and Is_Pragma_Name -- correctly recognize and process Priority. Priority is a standard Ada 95 -- pragma. @@ -625,6 +629,12 @@ package Snames is Name_Remote_Access_Type : constant Name_Id := N + $; -- GNAT Name_Remote_Call_Interface : constant Name_Id := N + $; Name_Remote_Types : constant Name_Id := N + $; + + -- Note: Secondary_Stack_Size is not in this list because its name matches + -- the name of the corresponding attribute. However, it is included in the + -- definition of the type Pragma_Id, and the functions Get_Pragma_Id and + -- Is_Pragma_Name correctly recognize and process Secondary_Stack_Size. + Name_Share_Generic : constant Name_Id := N + $; -- GNAT Name_Shared : constant Name_Id := N + $; -- Ada 83 Name_Shared_Passive : constant Name_Id := N + $; @@ -632,8 +642,8 @@ package Snames is -- Note: Storage_Size is not in this list because its name matches the name -- of the corresponding attribute. However, it is included in the - -- definition of the type Attribute_Id, and the functions Get_Pragma_Id and - -- Is_Pragma_Id correctly recognize and process Name_Storage_Size. + -- definition of the type Pragma_Id, and the functions Get_Pragma_Id and + -- Is_Pragma_Name correctly recognize and process Name_Storage_Size. -- Note: Storage_Unit is also omitted from the list because of a clash with -- an attribute name, and is treated similarly. @@ -1758,11 +1768,9 @@ package Snames is type Pragma_Id is ( - -- Configuration pragmas - - -- Note: This list is in the GNAT users guide, so be sure that if any - -- additions or deletions are made to the following list, they are - -- properly reflected in the users guide. + -- Configuration pragmas are grouped at start. Note that there is a list + -- of them in the GNAT UG (doc/gnat_ugn/the_gnat_compilation_model.rst), + -- be sure to update this list if a new configuration pragma is added. Pragma_Ada_83, Pragma_Ada_95, @@ -1773,9 +1781,7 @@ package Snames is Pragma_Allow_Integer_Address, Pragma_Annotate, Pragma_Assertion_Policy, - Pragma_Assume, Pragma_Assume_No_Invalid_Values, - Pragma_Attribute_Definition, Pragma_C_Pass_By_Copy, Pragma_Check_Float_Overflow, Pragma_Check_Name, @@ -1804,11 +1810,9 @@ package Snames is Pragma_Interrupt_State, Pragma_License, Pragma_Locking_Policy, - Pragma_Loop_Optimize, Pragma_No_Heap_Finalization, Pragma_No_Run_Time, Pragma_No_Strict_Aliasing, - Pragma_No_Tagged_Streams, Pragma_Normalize_Scalars, Pragma_Optimize_Alignment, Pragma_Overflow_Mode, @@ -1854,12 +1858,14 @@ package Snames is Pragma_All_Calls_Remote, Pragma_Assert, Pragma_Assert_And_Cut, + Pragma_Assume, Pragma_Async_Readers, Pragma_Async_Writers, Pragma_Asynchronous, Pragma_Atomic, Pragma_Atomic_Components, Pragma_Attach_Handler, + Pragma_Attribute_Definition, Pragma_Check, Pragma_Comment, Pragma_Common_Object, @@ -1921,6 +1927,7 @@ package Snames is Pragma_Linker_Section, Pragma_List, Pragma_Loop_Invariant, + Pragma_Loop_Optimize, Pragma_Loop_Variant, Pragma_Machine_Attribute, Pragma_Main, @@ -1931,6 +1938,7 @@ package Snames is Pragma_No_Elaboration_Code_All, Pragma_No_Inline, Pragma_No_Return, + Pragma_No_Tagged_Streams, Pragma_Obsolescent, Pragma_Optimize, Pragma_Ordered, -- 2.30.2