From aafc151a206edfc9352ea637ec2f2bdb39003135 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 26 Oct 2015 12:55:18 +0100 Subject: [PATCH] [multiple changes] 2015-10-26 Hristian Kirtchev * einfo.adb (First_Component): Update the assertion to allow for concurrent types. (First_Component_Or_Discriminant): Update the assertion to allow for concurrent types. * einfo.ads: Update the documentation of attributes First_Component and First_Component_Or_Discriminant along with uses in entities. 2015-10-26 Hristian Kirtchev * sem_res.adb (Resolve_Actuals): An effectively volatile object may act as an actual when the corresponding formal is of a non-scalar effectively volatile type, not just a non-scalar volatile type. 2015-10-26 Bob Duff * sinfo.ads, sem_util.ads: Update comments. 2015-10-26 Hristian Kirtchev * sem_prag.adb (Analyze_Refined_Depends_Global_Post): When dealing with protected entries or protected subprograms, use the enclosing protected type to ensure that the protected type declaration is declared in a package spec. Remove an obsolete attempt to ensure the aggregate for of pragma Refined_State as this routine is never called in that case. 2015-10-26 Ed Schonberg * exp_ch5.adb (Expand_Iterator_Loop_Over_Container): For an element iterator loop, the element is a constant if the container object is a constant, even if the container type has a Variable_Indexing aspect. From-SVN: r229345 --- gcc/ada/ChangeLog | 36 ++++++++++++++++++++++++++++++++++++ gcc/ada/einfo.adb | 7 +++++-- gcc/ada/einfo.ads | 17 +++++++++++------ gcc/ada/exp_ch5.adb | 6 +++++- gcc/ada/sem_prag.adb | 20 +++++++++++--------- gcc/ada/sem_res.adb | 8 ++++---- gcc/ada/sem_util.ads | 20 ++++++++++---------- gcc/ada/sinfo.ads | 2 +- 8 files changed, 83 insertions(+), 33 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8b146ae655e..8951f1105e7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,39 @@ +2015-10-26 Hristian Kirtchev + + * einfo.adb (First_Component): Update the assertion to allow + for concurrent types. + (First_Component_Or_Discriminant): Update the assertion to allow for + concurrent types. + * einfo.ads: Update the documentation of attributes First_Component + and First_Component_Or_Discriminant along with uses in entities. + +2015-10-26 Hristian Kirtchev + + * sem_res.adb (Resolve_Actuals): An effectively + volatile object may act as an actual when the corresponding + formal is of a non-scalar effectively volatile type, not just + a non-scalar volatile type. + +2015-10-26 Bob Duff + + * sinfo.ads, sem_util.ads: Update comments. + +2015-10-26 Hristian Kirtchev + + * sem_prag.adb (Analyze_Refined_Depends_Global_Post): When dealing with + protected entries or protected subprograms, use the enclosing protected + type to ensure that the protected type declaration is declared + in a package spec. Remove an obsolete attempt to ensure the + aggregate for of pragma Refined_State as this routine is never + called in that case. + +2015-10-26 Ed Schonberg + + * exp_ch5.adb (Expand_Iterator_Loop_Over_Container): For + an element iterator loop, the element is a constant if the + container object is a constant, even if the container type has + a Variable_Indexing aspect. + 2015-10-26 Bob Duff * s-fileio.adb (Fopen_Mode): Use "r+" for Out_File/Stream_IO, diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index d7d19ab5117..c8e6fcfe719 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -6926,7 +6926,9 @@ package body Einfo is begin pragma Assert - (Is_Record_Type (Id) or else Is_Incomplete_Or_Private_Type (Id)); + (Is_Concurrent_Type (Id) + or else Is_Incomplete_Or_Private_Type (Id) + or else Is_Record_Type (Id)); Comp_Id := First_Entity (Id); while Present (Comp_Id) loop @@ -6946,8 +6948,9 @@ package body Einfo is begin pragma Assert - (Is_Record_Type (Id) + (Is_Concurrent_Type (Id) or else Is_Incomplete_Or_Private_Type (Id) + or else Is_Record_Type (Id) or else Has_Discriminants (Id)); Comp_Id := First_Entity (Id); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 22e42dd6de1..21d700e2037 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1286,14 +1286,15 @@ package Einfo is -- objects. -- First_Component (synthesized) --- Applies to record types. Returns the first component by following the --- chain of declared entities for the record until a component is found --- (one with an Ekind of E_Component). The discriminants are skipped. If --- the record is null, then Empty is returned. +-- Applies to incomplete, private, protected, record and task types. +-- Returns the first component by following the chain of declared +-- entities for the type a component is found (one with an Ekind of +-- E_Component). The discriminants are skipped. If the record is null, +-- then Empty is returned. -- First_Component_Or_Discriminant (synthesized) --- Similar to First_Component, but discriminants are not skipped, so will --- find the first discriminant if discriminants are present. +-- Similar to First_Component, but discriminants are not skipped, so will +-- find the first discriminant if discriminants are present. -- First_Entity (Node17) -- Defined in all entities which act as scopes to which a list of @@ -6263,6 +6264,8 @@ package Einfo is -- SPARK_Pragma_Inherited (Flag265) -- Uses_Lock_Free (Flag188) -- Uses_Sec_Stack (Flag95) ??? + -- First_Component (synth) + -- First_Component_Or_Discriminant (synth) -- Has_Entries (synth) -- Has_Interrupt_Handler (synth) -- Number_Entries (synth) @@ -6410,6 +6413,8 @@ package Einfo is -- SPARK_Aux_Pragma_Inherited (Flag266) -- SPARK_Pragma_Inherited (Flag265) -- Uses_Sec_Stack (Flag95) ??? + -- First_Component (synth) + -- First_Component_Or_Discriminant (synth) -- Has_Entries (synth) -- Number_Entries (synth) -- (plus type attributes) diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 5b3dd7511a7..dbefc051d47 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -3864,10 +3864,14 @@ package body Exp_Ch5 is Set_Debug_Info_Needed (Id); -- If the container does not have a variable indexing aspect, - -- the element is a constant in the loop. + -- the element is a constant in the loop. The container itself + -- may be constant, in which case the element is a constant as + -- well. The container has been rewritten as a call to Iterate, + -- so examine original node. if No (Find_Value_Of_Aspect (Container_Typ, Aspect_Variable_Indexing)) + or else not Is_Variable (Original_Node (Container)) then Set_Ekind (Id, E_Constant); end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index cd0a392c7fc..3972ac35d6d 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -3879,17 +3879,22 @@ package body Sem_Prag is return; end if; - -- The pragma can only apply to the body [stub] of a subprogram + -- A refined pragma can only apply to the body [stub] of a subprogram -- declared in the visible part of a package. Retrieve the context of -- the subprogram declaration. Spec_Decl := Unit_Declaration_Node (Spec_Id); - -- The proper context of a entry declaration is the declaration of - -- the enclosing synchronized type. + -- When dealing with protected entries or protected subprograms, use + -- the enclosing protected type as the proper context. - if Nkind (Spec_Decl) = N_Entry_Declaration then - Spec_Decl := Parent (Parent (Spec_Decl)); + if Ekind_In (Spec_Id, E_Entry, + E_Entry_Family, + E_Function, + E_Procedure) + and then Ekind (Scope (Spec_Id)) = E_Protected_Type + then + Spec_Decl := Declaration_Node (Scope (Spec_Id)); end if; if Nkind (Parent (Spec_Decl)) /= N_Package_Specification then @@ -3908,10 +3913,7 @@ package body Sem_Prag is Mark_Pragma_As_Ghost (N, Spec_Id); - if Nam_In (Pname, Name_Refined_Depends, - Name_Refined_Global, - Name_Refined_State) - then + if Nam_In (Pname, Name_Refined_Depends, Name_Refined_Global) then Ensure_Aggregate_Form (Get_Argument (N, Spec_Id)); end if; end Analyze_Refined_Depends_Global_Post; diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 57067f49428..3ecc33b9dc7 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4465,11 +4465,11 @@ package body Sem_Res is and then Is_Effectively_Volatile_Object (A) then -- An effectively volatile object may act as an actual when the - -- corresponding formal is of a non-scalar volatile type - -- (SPARK RM 7.1.3(12)). + -- corresponding formal is of a non-scalar effectively volatile + -- type (SPARK RM 7.1.3(12)). - if Is_Volatile (Etype (F)) - and then not Is_Scalar_Type (Etype (F)) + if not Is_Scalar_Type (Etype (F)) + and then Is_Effectively_Volatile (Etype (F)) then null; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 973cb7df326..570ecf80d35 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -741,16 +741,16 @@ package Sem_Util is -- alternatives, and the warnings that may apply to them, are removed. function First_Actual (Node : Node_Id) return Node_Id; - -- Node is an N_Function_Call or N_Procedure_Call_Statement node. The - -- result returned is the first actual parameter in declaration order - -- (not the order of parameters as they appeared in the source, which - -- can be quite different as a result of the use of named parameters). - -- Empty is returned for a call with no parameters. The procedure for - -- iterating through the actuals in declaration order is to use this - -- function to find the first actual, and then use Next_Actual to obtain - -- the next actual in declaration order. Note that the value returned - -- is always the expression (not the N_Parameter_Association nodes, - -- even if named association is used). + -- Node is an N_Function_Call, N_Procedure_Call_Statement or + -- N_Entry_Call_Statement node. The result returned is the first actual + -- parameter in declaration order (not the order of parameters as they + -- appeared in the source, which can be quite different as a result of the + -- use of named parameters). Empty is returned for a call with no + -- parameters. The procedure for iterating through the actuals in + -- declaration order is to use this function to find the first actual, and + -- then use Next_Actual to obtain the next actual in declaration order. + -- Note that the value returned is always the expression (not the + -- N_Parameter_Association nodes, even if named association is used). procedure Gather_Components (Typ : Entity_Id; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 8a3e51b8366..ab76d2c80ab 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -3700,7 +3700,7 @@ package Sinfo is -- node. See description of this node in the section on semantic nodes. -- N_Selected_Component - -- Sloc points to period + -- Sloc points to the period -- Prefix (Node3) -- Selector_Name (Node2) -- Associated_Node (Node4-Sem) -- 2.30.2