diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 32 | ||||
| -rw-r--r-- | gcc/ada/einfo.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/sem_attr.adb | 44 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 41 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_ch7.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 471 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 34 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 3 |
9 files changed, 385 insertions, 256 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fcd2915..669f064 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,35 @@ +2013-04-25 Hristian Kirtchev <kirtchev@adacore.com> + + * einfo.adb (Set_Abstract_States): The attribute now applies + to generic packages. + * sem_ch4.adb (Referenced): Moved to sem_util. + * sem_ch7.adb (Unit_Requires_Body): A [generic] package with + a non-null abstract state needs a body. + * sem_prag.adb (Analyze_Depends_In_Decl_Part): Update the calls + to Collect_Subprogram_Inputs_Outputs. + (Analyze_Global_Item): Verify the proper usage of an item with mode + In_Out or Output relative to the enclosing context. + (Analyze_Pragma): Abstract_State can now be applied to a generic + package. Do not reset the Analyzed flag for pragmas Depends and Global + as this is not needed. + (Appears_In): Moved to library level. + (Check_Mode_Restiction_In_Enclosing_Context): New routine. + (Collect_Subprogram_Inputs_Outputs): Moved to library level. Add + formal parameters Subp_Id, Subp_Inputs, Subp_Outputs and Global + seen along with comments on usage. + * sem_util.ads, sem_util.adb (Referenced): New routine. + +2013-04-25 Hristian Kirtchev <kirtchev@adacore.com> + + * sem_ch6.adb (Expand_Contract_Cases): Generate + detailed error messages only when switch -gnateE is in effect. + +2013-04-25 Yannick Moy <moy@adacore.com> + + * sem_attr.adb (Analyze_Attribute): Do not issue + an error for a possibly misplaced 'Result or 'Old attribute when + analyzing the aspect. + 2013-04-25 Robert Dewar <dewar@adacore.com> * sem_ch12.adb, sem_util.adb, sem_ch4.adb: Minor reformatting. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index c018363..bfe5b37 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -3233,7 +3233,7 @@ package body Einfo is procedure Set_Abstract_States (Id : E; V : L) is begin - pragma Assert (Ekind (Id) = E_Package); + pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package)); Set_Elist25 (Id, V); end Set_Abstract_States; diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 59c83bb..f52abe9 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -4222,15 +4222,24 @@ package body Sem_Attr is -- Check in postcondition, Test_Case or Contract_Cases Prag := N; - while not Nkind_In (Prag, N_Pragma, - N_Function_Specification, - N_Procedure_Specification, - N_Subprogram_Body) + while Present (Prag) + and then not Nkind_In (Prag, N_Pragma, + N_Function_Specification, + N_Procedure_Specification, + N_Aspect_Specification, + N_Subprogram_Body) loop Prag := Parent (Prag); end loop; - if Nkind (Prag) /= N_Pragma then + -- In ASIS mode, the aspect itself is analyzed, in addition to the + -- corresponding pragma. Do not issue errors when analyzing the + -- aspect. + + if Nkind (Prag) = N_Aspect_Specification then + null; + + elsif Nkind (Prag) /= N_Pragma then Error_Attr ("% attribute can only appear in postcondition", P); elsif Get_Pragma_Id (Prag) = Pragma_Test_Case then @@ -4241,7 +4250,7 @@ package body Sem_Attr is begin Arg := N; - while Arg /= Prag and Arg /= Arg_Ens loop + while Arg /= Prag and then Arg /= Arg_Ens loop Arg := Parent (Arg); end loop; @@ -4258,7 +4267,7 @@ package body Sem_Attr is begin Arg := N; - while Arg /= Prag and Parent (Parent (Arg)) /= Aggr loop + while Arg /= Prag and then Parent (Parent (Arg)) /= Aggr loop Arg := Parent (Arg); end loop; @@ -4628,14 +4637,23 @@ package body Sem_Attr is -- Check in postcondition, Test_Case or Contract_Cases of function Prag := N; - while not Nkind_In (Prag, N_Pragma, - N_Function_Specification, - N_Subprogram_Body) + while Present (Prag) + and then not Nkind_In (Prag, N_Pragma, + N_Function_Specification, + N_Aspect_Specification, + N_Subprogram_Body) loop Prag := Parent (Prag); end loop; - if Nkind (Prag) /= N_Pragma then + -- In ASIS mode, the aspect itself is analyzed, in addition to the + -- corresponding pragma. Do not issue errors when analyzing the + -- aspect. + + if Nkind (Prag) = N_Aspect_Specification then + null; + + elsif Nkind (Prag) /= N_Pragma then Error_Attr ("% attribute can only appear in postcondition of function", P); @@ -4648,7 +4666,7 @@ package body Sem_Attr is begin Arg := N; - while Arg /= Prag and Arg /= Arg_Ens loop + while Arg /= Prag and then Arg /= Arg_Ens loop Arg := Parent (Arg); end loop; @@ -4665,7 +4683,7 @@ package body Sem_Attr is begin Arg := N; - while Arg /= Prag and Parent (Parent (Arg)) /= Aggr loop + while Arg /= Prag and then Parent (Parent (Arg)) /= Aggr loop Arg := Parent (Arg); end loop; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index e4b5139..04db9b0 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3510,10 +3510,6 @@ package body Sem_Ch4 is -- Determine whether if expression If_Expr lacks an else part or if it -- has one, it evaluates to True. - function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean; - -- Determine whether entity Id is referenced within expression Expr - -- This should be moved to sem_util ??? - -------------------- -- Is_Empty_Range -- -------------------- @@ -3565,43 +3561,6 @@ package body Sem_Ch4 is and then Is_True (Expr_Value (Else_Expr))); end No_Else_Or_Trivial_True; - ---------------- - -- Referenced -- - ---------------- - - function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean is - Seen : Boolean := False; - - function Is_Reference (N : Node_Id) return Traverse_Result; - -- Determine whether node N denotes a reference to Id. If this is the - -- case, set global flag Seen to True and stop the traversal. - - ------------------ - -- Is_Reference -- - ------------------ - - function Is_Reference (N : Node_Id) return Traverse_Result is - begin - if Is_Entity_Name (N) - and then Present (Entity (N)) - and then Entity (N) = Id - then - Seen := True; - return Abandon; - else - return OK; - end if; - end Is_Reference; - - procedure Inspect_Expression is new Traverse_Proc (Is_Reference); - - -- Start of processing for Referenced - - begin - Inspect_Expression (Expr); - return Seen; - end Referenced; - -- Local variables Cond : constant Node_Id := Condition (N); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 3d709cf..1a97de2 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -11655,7 +11655,7 @@ package body Sem_Ch6 is -- Check possible overlap between a case guard and "others" - if Multiple_PCs then + if Multiple_PCs and then Exception_Extra_Info then Case_Guard_Error (Decls => Error_Decls, Flag => Others_Flag, @@ -11695,7 +11695,7 @@ package body Sem_Ch6 is -- Check whether this case guard overlaps with another case -- guard. - if Multiple_PCs then + if Multiple_PCs and then Exception_Extra_Info then Case_Guard_Error (Decls => Error_Decls, Flag => Flag, diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 59d566a..505fe9d 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -2615,6 +2615,16 @@ package body Sem_Ch7 is return True; end if; end; + + -- A [generic] package that introduces at least one non-null abstract + -- state requires completion. A null abstract state always appears as + -- the sole element of the state list. + + elsif Ekind_In (P, E_Generic_Package, E_Package) + and then Present (Abstract_States (P)) + and then not Is_Null_State (Node (First_Elmt (Abstract_States (P)))) + then + return True; end if; -- Otherwise search entity chain for entity requiring completion diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 01297f4..0874528 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -181,6 +181,22 @@ package body Sem_Prag is -- to Uppercase or Lowercase, then a new string literal with appropriate -- casing is constructed. + function Appears_In (List : Elist_Id; Item_Id : Entity_Id) return Boolean; + -- Subsidiary to the analysis of pragma Global and pragma Depends. Query + -- whether a particular item appears in a mixed list of nodes and entities. + -- It is assumed that all nodes in the list have entities. + + procedure Collect_Subprogram_Inputs_Outputs + (Subp_Id : Entity_Id; + Subp_Inputs : in out Elist_Id; + Subp_Outputs : in out Elist_Id; + Global_Seen : out Boolean); + -- Subsidiary to the analysis of pragma Global and pragma Depends. Gather + -- all inputs and outputs of subprogram Subp_Id in lists Subp_Inputs and + -- Subp_Outputs. If the case where the subprogram has no inputs and/or + -- outputs, the corresponding returned list is No_Elist. Flag Global_Seen + -- is set when the related subprogram has aspect/pragma Global. + function Find_Related_Subprogram (Prag : Node_Id; Check_Duplicates : Boolean := False) return Node_Id; @@ -448,12 +464,6 @@ package body Sem_Prag is -- Verify the legality of a single dependency clause. Flag Is_Last -- denotes whether Clause is the last clause in the relation. - function Appears_In - (List : Elist_Id; - Item_Id : Entity_Id) return Boolean; - -- Determine whether a particular item appears in a mixed list of nodes - -- and entities. - procedure Check_Function_Return; -- Verify that Funtion'Result appears as one of the outputs @@ -476,10 +486,6 @@ package body Sem_Prag is -- Verify that all items from Subp_Items appear in Used_Items. Emit an -- error if this is not the case. - procedure Collect_Subprogram_Inputs_Outputs; - -- Gather all inputs and outputs of the subprogram. These are the formal - -- parameters and entities classified in pragma Global. - procedure Normalize_Clause (Clause : Node_Id); -- Remove a self-dependency "+" from the input list of a clause. -- Depending on the contents of the relation, either split the the @@ -787,38 +793,6 @@ package body Sem_Prag is Analyze_Input_List (Inputs); end Analyze_Dependency_Clause; - ---------------- - -- Appears_In -- - ---------------- - - function Appears_In - (List : Elist_Id; - Item_Id : Entity_Id) return Boolean - is - Elmt : Elmt_Id; - Id : Entity_Id; - - begin - if Present (List) then - Elmt := First_Elmt (List); - while Present (Elmt) loop - if Nkind (Node (Elmt)) = N_Defining_Identifier then - Id := Node (Elmt); - else - Id := Entity (Node (Elmt)); - end if; - - if Id = Item_Id then - return True; - end if; - - Next_Elmt (Elmt); - end loop; - end if; - - return False; - end Appears_In; - ---------------------------- -- Check_Function_Return -- ---------------------------- @@ -961,138 +935,6 @@ package body Sem_Prag is end loop; end Check_Usage; - --------------------------------------- - -- Collect_Subprogram_Inputs_Outputs -- - --------------------------------------- - - procedure Collect_Subprogram_Inputs_Outputs is - procedure Collect_Global_List - (List : Node_Id; - Mode : Name_Id := Name_Input); - -- Collect all relevant items from a global list - - ------------------------- - -- Collect_Global_List -- - ------------------------- - - procedure Collect_Global_List - (List : Node_Id; - Mode : Name_Id := Name_Input) - is - procedure Collect_Global_Item - (Item : Node_Id; - Mode : Name_Id); - -- Add an item to the proper subprogram input or output collection - - ------------------------- - -- Collect_Global_Item -- - ------------------------- - - procedure Collect_Global_Item - (Item : Node_Id; - Mode : Name_Id) - is - begin - if Nam_In (Mode, Name_In_Out, Name_Input) then - Add_Item (Item, Subp_Inputs); - end if; - - if Nam_In (Mode, Name_In_Out, Name_Output) then - Add_Item (Item, Subp_Outputs); - end if; - end Collect_Global_Item; - - -- Local variables - - Assoc : Node_Id; - Item : Node_Id; - - -- Start of processing for Collect_Global_List - - begin - -- Single global item declaration - - if Nkind_In (List, N_Identifier, N_Selected_Component) then - Collect_Global_Item (List, Mode); - - -- Simple global list or moded global list declaration - - else - if Present (Expressions (List)) then - Item := First (Expressions (List)); - while Present (Item) loop - Collect_Global_Item (Item, Mode); - - Next (Item); - end loop; - - else - Assoc := First (Component_Associations (List)); - while Present (Assoc) loop - Collect_Global_List - (List => Expression (Assoc), - Mode => Chars (First (Choices (Assoc)))); - - Next (Assoc); - end loop; - end if; - end if; - end Collect_Global_List; - - -- Local variables - - Formal : Entity_Id; - Global : Node_Id; - List : Node_Id; - - -- Start of processing for Collect_Subprogram_Inputs_Outputs - - begin - -- Process all formal parameters - - Formal := First_Formal (Subp_Id); - while Present (Formal) loop - if Ekind_In (Formal, E_In_Out_Parameter, E_In_Parameter) then - Add_Item (Formal, Subp_Inputs); - end if; - - if Ekind_In (Formal, E_In_Out_Parameter, E_Out_Parameter) then - Add_Item (Formal, Subp_Outputs); - end if; - - Next_Formal (Formal); - end loop; - - -- If the subprogram is subject to pragma Global, traverse all global - -- lists and gather the relevant items. - - Global := Find_Aspect (Subp_Id, Aspect_Global); - if Present (Global) then - Global_Seen := True; - - -- Retrieve the pragma as it contains the analyzed lists - - Global := Aspect_Rep_Item (Global); - - -- The pragma may not have been analyzed because of the arbitrary - -- declaration order of aspects. Make sure that it is analyzed for - -- the purposes of item extraction. - - if not Analyzed (Global) then - Analyze_Global_In_Decl_Part (Global); - end if; - - List := - Expression (First (Pragma_Argument_Associations (Global))); - - -- Nothing to be done for a null global list - - if Nkind (List) /= N_Null then - Collect_Global_List (List); - end if; - end if; - end Collect_Subprogram_Inputs_Outputs; - ---------------------- -- Normalize_Clause -- ---------------------- @@ -1382,7 +1224,11 @@ package body Sem_Prag is -- subprogram may depend on. These items are obtained from the -- parameter profile or pragma Global (if available). - Collect_Subprogram_Inputs_Outputs; + Collect_Subprogram_Inputs_Outputs + (Subp_Id => Subp_Id, + Subp_Inputs => Subp_Inputs, + Subp_Outputs => Subp_Outputs, + Global_Seen => Global_Seen); -- Verify that every input or output of the subprogram appear in a -- dependency. @@ -1402,7 +1248,11 @@ package body Sem_Prag is -- subprogram may depend on. These items are obtained from the -- parameter profile or pragma Global (if available). - Collect_Subprogram_Inputs_Outputs; + Collect_Subprogram_Inputs_Outputs + (Subp_Id => Subp_Id, + Subp_Inputs => Subp_Inputs, + Subp_Outputs => Subp_Outputs, + Global_Seen => Global_Seen); -- Ensure that the formal parameters are visible when analyzing all -- clauses. This falls out of the general rule of aspects pertaining @@ -1505,6 +1355,14 @@ package body Sem_Prag is -- processing a global list. This routine verifies that Mode is not a -- duplicate mode and sets the flag Status. + procedure Check_Mode_Restiction_In_Enclosing_Context + (Item : Node_Id; + Item_Id : Entity_Id); + -- Verify that an item of mode In_Out or Output does not appear as an + -- input in the Global aspect of an enclosing subprogram. If this is + -- the case, emit an error. Item and Item_Id are respectively the + -- item and its entity. + procedure Check_Mode_Restriction_In_Function (Mode : Node_Id); -- Mode denotes either In_Out or Output. Depending on the kind of the -- related subprogram, emit an error if those two modes apply to a @@ -1574,18 +1432,8 @@ package body Sem_Prag is return; end if; - -- The same entity might be referenced through various way. Check - -- the entity of the item rather than the item itself. - - if Contains (Seen, Item_Id) then - Error_Msg_N ("duplicate global item", Item); - - -- Add the entity of the current item to the list of processed - -- items. - - else - Add_Item (Item_Id, Seen); - end if; + -- At this point we know that the global item is one of the two + -- valid choices. Perform mode- and usage-specific checks. if Ekind (Item_Id) = E_Abstract_State and then Is_Volatile_State (Item_Id) @@ -1611,6 +1459,26 @@ package body Sem_Prag is & "Volatile Output state", Item); end if; end if; + + -- Verify that an output does not appear as an input in an + -- enclosing subprogram. + + if Nam_In (Global_Mode, Name_In_Out, Name_Output) then + Check_Mode_Restiction_In_Enclosing_Context (Item, Item_Id); + end if; + + -- The same entity might be referenced through various way. Check + -- the entity of the item rather than the item itself. + + if Contains (Seen, Item_Id) then + Error_Msg_N ("duplicate global item", Item); + + -- Add the entity of the current item to the list of processed + -- items. + + else + Add_Item (Item_Id, Seen); + end if; end Analyze_Global_Item; -------------------------- @@ -1629,6 +1497,53 @@ package body Sem_Prag is Status := True; end Check_Duplicate_Mode; + ------------------------------------------------ + -- Check_Mode_Restiction_In_Enclosing_Context -- + ------------------------------------------------ + + procedure Check_Mode_Restiction_In_Enclosing_Context + (Item : Node_Id; + Item_Id : Entity_Id) + is + Dummy : Boolean; + Inputs : Elist_Id := No_Elist; + Outputs : Elist_Id := No_Elist; + Subp_Id : Entity_Id; + + begin + -- Traverse the scope stack looking for enclosing subprograms + -- subject to aspect/pragma Global. + + Subp_Id := Scope (Current_Scope); + while Present (Subp_Id) and then Subp_Id /= Standard_Standard loop + if Is_Subprogram (Subp_Id) + and then Has_Aspect (Subp_Id, Aspect_Global) + then + Collect_Subprogram_Inputs_Outputs + (Subp_Id => Subp_Id, + Subp_Inputs => Inputs, + Subp_Outputs => Outputs, + Global_Seen => Dummy); + + -- The item is classified as In_Out or Output but appears as + -- an Input in an enclosing subprogram. + + if Appears_In (Inputs, Item_Id) + and then not Appears_In (Outputs, Item_Id) + then + Error_Msg_NE + ("global item & cannot have mode In_Out or Output", + Item, Item_Id); + Error_Msg_NE + ("\item already appears as input of subprogram &", + Item, Subp_Id); + end if; + end if; + + Subp_Id := Scope (Subp_Id); + end loop; + end Check_Mode_Restiction_In_Enclosing_Context; + ---------------------------------------- -- Check_Mode_Restriction_In_Function -- ---------------------------------------- @@ -8559,7 +8474,9 @@ package body Sem_Prag is Par := Unit (Par); end if; - if Nkind (Par) /= N_Package_Declaration then + if not Nkind_In (Par, N_Generic_Package_Declaration, + N_Package_Declaration) + then Pragma_Misplaced; return; end if; @@ -10660,11 +10577,6 @@ package body Sem_Prag is Subp_Id := Defining_Unit_Name (Specification (Subp_Decl)); - -- The pragma is analyzed at the end of the declarative part which - -- contains the related subprogram. Reset the analyzed flag. - - Set_Analyzed (N, False); - -- When the aspect/pragma appears on a subprogram body, perform -- the full analysis now. @@ -11906,11 +11818,6 @@ package body Sem_Prag is Subp_Id := Defining_Unit_Name (Specification (Subp_Decl)); - -- The pragma is analyzed at the end of the declarative part which - -- contains the related subprogram. Reset the analyzed flag. - - Set_Analyzed (N, False); - -- When the aspect/pragma appears on a subprogram body, perform -- the full analysis now. @@ -17895,6 +17802,35 @@ package body Sem_Prag is end Analyze_Test_Case_In_Decl_Part; ---------------- + -- Appears_In -- + ---------------- + + function Appears_In (List : Elist_Id; Item_Id : Entity_Id) return Boolean is + Elmt : Elmt_Id; + Id : Entity_Id; + + begin + if Present (List) then + Elmt := First_Elmt (List); + while Present (Elmt) loop + if Nkind (Node (Elmt)) = N_Defining_Identifier then + Id := Node (Elmt); + else + Id := Entity (Node (Elmt)); + end if; + + if Id = Item_Id then + return True; + end if; + + Next_Elmt (Elmt); + end loop; + end if; + + return False; + end Appears_In; + + ---------------- -- Check_Kind -- ---------------- @@ -18007,6 +17943,143 @@ package body Sem_Prag is end if; end Check_Applicable_Policy; + --------------------------------------- + -- Collect_Subprogram_Inputs_Outputs -- + --------------------------------------- + + procedure Collect_Subprogram_Inputs_Outputs + (Subp_Id : Entity_Id; + Subp_Inputs : in out Elist_Id; + Subp_Outputs : in out Elist_Id; + Global_Seen : out Boolean) + is + procedure Collect_Global_List + (List : Node_Id; + Mode : Name_Id := Name_Input); + -- Collect all relevant items from a global list + + ------------------------- + -- Collect_Global_List -- + ------------------------- + + procedure Collect_Global_List + (List : Node_Id; + Mode : Name_Id := Name_Input) + is + procedure Collect_Global_Item + (Item : Node_Id; + Mode : Name_Id); + -- Add an item to the proper subprogram input or output collection + + ------------------------- + -- Collect_Global_Item -- + ------------------------- + + procedure Collect_Global_Item + (Item : Node_Id; + Mode : Name_Id) + is + begin + if Nam_In (Mode, Name_In_Out, Name_Input) then + Add_Item (Item, Subp_Inputs); + end if; + + if Nam_In (Mode, Name_In_Out, Name_Output) then + Add_Item (Item, Subp_Outputs); + end if; + end Collect_Global_Item; + + -- Local variables + + Assoc : Node_Id; + Item : Node_Id; + + -- Start of processing for Collect_Global_List + + begin + -- Single global item declaration + + if Nkind_In (List, N_Identifier, N_Selected_Component) then + Collect_Global_Item (List, Mode); + + -- Simple global list or moded global list declaration + + else + if Present (Expressions (List)) then + Item := First (Expressions (List)); + while Present (Item) loop + Collect_Global_Item (Item, Mode); + + Next (Item); + end loop; + + else + Assoc := First (Component_Associations (List)); + while Present (Assoc) loop + Collect_Global_List + (List => Expression (Assoc), + Mode => Chars (First (Choices (Assoc)))); + + Next (Assoc); + end loop; + end if; + end if; + end Collect_Global_List; + + -- Local variables + + Formal : Entity_Id; + Global : Node_Id; + List : Node_Id; + + -- Start of processing for Collect_Subprogram_Inputs_Outputs + + begin + Global_Seen := False; + + -- Process all formal parameters + + Formal := First_Formal (Subp_Id); + while Present (Formal) loop + if Ekind_In (Formal, E_In_Out_Parameter, E_In_Parameter) then + Add_Item (Formal, Subp_Inputs); + end if; + + if Ekind_In (Formal, E_In_Out_Parameter, E_Out_Parameter) then + Add_Item (Formal, Subp_Outputs); + end if; + + Next_Formal (Formal); + end loop; + + -- If the subprogram is subject to pragma Global, traverse all global + -- lists and gather the relevant items. + + Global := Find_Aspect (Subp_Id, Aspect_Global); + if Present (Global) then + Global_Seen := True; + + -- Retrieve the pragma as it contains the analyzed lists + + Global := Aspect_Rep_Item (Global); + List := Expression (First (Pragma_Argument_Associations (Global))); + + -- The pragma may not have been analyzed because of the arbitrary + -- declaration order of aspects. Make sure that it is analyzed for + -- the purposes of item extraction. + + if not Analyzed (List) then + Analyze_Global_In_Decl_Part (Global); + end if; + + -- Nothing to be done for a null global list + + if Nkind (List) /= N_Null then + Collect_Global_List (List); + end if; + end if; + end Collect_Subprogram_Inputs_Outputs; + --------------------------------- -- Delay_Config_Pragma_Analyze -- --------------------------------- diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index dfbfa86..0d732d2 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -12964,6 +12964,40 @@ package body Sem_Util is Set_Sloc (Endl, Loc); end Process_End_Label; + ---------------- + -- Referenced -- + ---------------- + + function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean is + Seen : Boolean := False; + + function Is_Reference (N : Node_Id) return Traverse_Result; + -- Determine whether node N denotes a reference to Id. If this is the + -- case, set global flag Seen to True and stop the traversal. + + function Is_Reference (N : Node_Id) return Traverse_Result is + begin + if Is_Entity_Name (N) + and then Present (Entity (N)) + and then Entity (N) = Id + then + Seen := True; + return Abandon; + else + return OK; + end if; + end Is_Reference; + + procedure Inspect_Expression is new Traverse_Proc (Is_Reference); + + -- Start of processing for Referenced + + begin + Inspect_Expression (Expr); + + return Seen; + end Referenced; + ------------------------------------ -- References_Generic_Formal_Type -- ------------------------------------ diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index c9b5da6..d6d1ecc 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1358,6 +1358,9 @@ package Sem_Util is -- parameter Ent gives the entity to which the End_Label refers, -- and to which cross-references are to be generated. + function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean; + -- Determine whether entity Id is referenced within expression Expr + function References_Generic_Formal_Type (N : Node_Id) return Boolean; -- Returns True if the expression Expr contains any references to a -- generic type. This can only happen within a generic template. |