diff options
Diffstat (limited to 'gcc/ada/sem_ch10.adb')
| -rw-r--r-- | gcc/ada/sem_ch10.adb | 236 |
1 files changed, 112 insertions, 124 deletions
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index ee18b37..76b68a1 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2019, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2020, 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- -- @@ -29,6 +29,7 @@ with Contracts; use Contracts; with Debug; use Debug; with Einfo; use Einfo; with Errout; use Errout; +with Exp_Put_Image; with Exp_Util; use Exp_Util; with Elists; use Elists; with Fname; use Fname; @@ -320,7 +321,6 @@ package body Sem_Ch10 is Nam_Ent : constant Entity_Id := Entity (Name (Clause)); Cont_Item : Node_Id; Prag_Unit : Node_Id; - Subt_Mark : Node_Id; Use_Item : Node_Id; function Same_Unit (N : Node_Id; P : Entity_Id) return Boolean; @@ -390,19 +390,31 @@ package body Sem_Ch10 is elsif Nkind (Cont_Item) = N_Use_Type_Clause and then not Used_Type_Or_Elab then - Subt_Mark := Subtype_Mark (Cont_Item); - if not Used_Type_Or_Elab - and then Same_Unit (Prefix (Subt_Mark), Nam_Ent) - then - Used_Type_Or_Elab := True; - end if; + declare + UE : Node_Id; + + begin + -- Loop through prefixes looking for a match + + UE := Prefix (Subtype_Mark (Cont_Item)); + loop + if not Used_Type_Or_Elab + and then Same_Unit (UE, Nam_Ent) + then + Used_Type_Or_Elab := True; + end if; + + exit when Nkind (UE) /= N_Expanded_Name; + UE := Prefix (UE); + end loop; + end; -- Pragma Elaborate or Elaborate_All elsif Nkind (Cont_Item) = N_Pragma and then - Nam_In (Pragma_Name_Unmapped (Cont_Item), - Name_Elaborate, Name_Elaborate_All) + Pragma_Name_Unmapped (Cont_Item) + in Name_Elaborate | Name_Elaborate_All and then not Used_Type_Or_Elab then Prag_Unit := @@ -610,6 +622,8 @@ package body Sem_Ch10 is -- Start of processing for Analyze_Compilation_Unit begin + Exp_Put_Image.Preload_Sink (N); + Process_Compilation_Unit_Pragmas (N); -- If the unit is a subunit whose parent has not been analyzed (which @@ -710,8 +724,8 @@ package body Sem_Ch10 is -- Verify that the library unit is a package declaration - if not Nkind_In (Unit (Lib_Unit), N_Package_Declaration, - N_Generic_Package_Declaration) + if Nkind (Unit (Lib_Unit)) not in + N_Package_Declaration | N_Generic_Package_Declaration then Error_Msg_N ("no legal package declaration for package body", N); @@ -938,8 +952,8 @@ package body Sem_Ch10 is -- Analyze the contract of a [generic] subprogram that acts as a -- compilation unit after all compilation pragmas have been analyzed. - if Nkind_In (Unit_Node, N_Generic_Subprogram_Declaration, - N_Subprogram_Declaration) + if Nkind (Unit_Node) in + N_Generic_Subprogram_Declaration | N_Subprogram_Declaration then Analyze_Entry_Or_Subprogram_Contract (Defining_Entity (Unit_Node)); end if; @@ -984,10 +998,10 @@ package body Sem_Ch10 is -- next compilation, which is either the main unit or some other unit -- in the context. - if Nkind_In (Unit_Node, N_Package_Declaration, - N_Package_Renaming_Declaration, - N_Subprogram_Declaration) - or else Nkind (Unit_Node) in N_Generic_Declaration + if Nkind (Unit_Node) in N_Package_Declaration + | N_Package_Renaming_Declaration + | N_Subprogram_Declaration + | N_Generic_Declaration or else (Nkind (Unit_Node) = N_Subprogram_Body and then Acts_As_Spec (Unit_Node)) then @@ -1135,9 +1149,9 @@ package body Sem_Ch10 is -- are triggered by these subprograms. if GNATprove_Mode - and then Nkind_In (Unit_Node, N_Function_Instantiation, - N_Procedure_Instantiation, - N_Subprogram_Body) + and then Nkind (Unit_Node) in N_Function_Instantiation + | N_Procedure_Instantiation + | N_Subprogram_Body then declare Spec : Node_Id; @@ -1176,10 +1190,10 @@ package body Sem_Ch10 is -- units manufactured by the compiler never need elab checks. if Comes_From_Source (N) - and then Nkind_In (Unit_Node, N_Package_Declaration, - N_Generic_Package_Declaration, - N_Subprogram_Declaration, - N_Generic_Subprogram_Declaration) + and then Nkind (Unit_Node) in N_Package_Declaration + | N_Generic_Package_Declaration + | N_Subprogram_Declaration + | N_Generic_Subprogram_Declaration then declare Loc : constant Source_Ptr := Sloc (N); @@ -1464,10 +1478,10 @@ package body Sem_Ch10 is -- Verify that the illegal contexts given in 10.1.2 (18/2) are -- properly rejected, including renaming declarations. - if not Nkind_In (Ukind, N_Package_Declaration, - N_Subprogram_Declaration) - and then Ukind not in N_Generic_Declaration - and then Ukind not in N_Generic_Instantiation + if Ukind not in N_Package_Declaration + | N_Subprogram_Declaration + | N_Generic_Declaration + | N_Generic_Instantiation then Error_Msg_N ("limited with_clause not allowed here", Item); @@ -1522,10 +1536,9 @@ package body Sem_Ch10 is if Item /= It and then Nkind (It) = N_With_Clause and then not Limited_Present (It) - and then - Nkind_In (Unit (Library_Unit (It)), - N_Package_Declaration, - N_Package_Renaming_Declaration) + and then Nkind (Unit (Library_Unit (It))) in + N_Package_Declaration | + N_Package_Renaming_Declaration then if Nkind (Unit (Library_Unit (It))) = N_Package_Declaration @@ -1655,9 +1668,9 @@ package body Sem_Ch10 is procedure Optional_Subunit; -- This procedure is called when the main unit is a stub, or when we -- are not generating code. In such a case, we analyze the subunit if - -- present, which is user-friendly and in fact required for ASIS, but we - -- don't complain if the subunit is missing. In GNATprove_Mode, we issue - -- an error to avoid formal verification of a partial unit. + -- present, which is user-friendly, but we don't complain if the subunit + -- is missing. In GNATprove_Mode, we issue an error to avoid formal + -- verification of a partial unit. ---------------------- -- Optional_Subunit -- @@ -1673,7 +1686,7 @@ package body Sem_Ch10 is -- ignore all errors. Note that Fatal_Error will still be set, so we -- will be able to check for this case below. - if not (ASIS_Mode or GNATprove_Mode) then + if not GNATprove_Mode then Ignore_Errors_Enable := Ignore_Errors_Enable + 1; end if; @@ -1684,7 +1697,7 @@ package body Sem_Ch10 is Subunit => True, Error_Node => N); - if not (ASIS_Mode or GNATprove_Mode) then + if not GNATprove_Mode then Ignore_Errors_Enable := Ignore_Errors_Enable - 1; end if; @@ -1808,27 +1821,13 @@ package body Sem_Ch10 is -- If the main unit is a subunit, then we are just performing semantic -- analysis on that subunit, and any other subunits of any parent unit - -- should be ignored, except that if we are building trees for ASIS - -- usage we want to annotate the stub properly. If the main unit is - -- itself a subunit, another subunit is irrelevant unless it is a - -- subunit of the current one, that is to say appears in the current - -- source tree. + -- should be ignored. If the main unit is itself a subunit, another + -- subunit is irrelevant unless it is a subunit of the current one, that + -- is to say appears in the current source tree. elsif Nkind (Unit (Cunit (Main_Unit))) = N_Subunit and then Subunit_Name /= Unit_Name (Main_Unit) then - if ASIS_Mode then - declare - PB : constant Node_Id := Proper_Body (Unit (Cunit (Main_Unit))); - begin - if Nkind_In (PB, N_Package_Body, N_Subprogram_Body) - and then List_Containing (N) = Declarations (PB) - then - Optional_Subunit; - end if; - end; - end if; - -- But before we return, set the flag for unloaded subunits. This -- will suppress junk warnings of variables in the same declarative -- part (or a higher level one) that are in danger of looking unused @@ -2022,9 +2021,8 @@ package body Sem_Ch10 is -- Verify that the identifier for the stub is unique within this -- declarative part. - if Nkind_In (Parent (N), N_Block_Statement, - N_Package_Body, - N_Subprogram_Body) + if Nkind (Parent (N)) in + N_Block_Statement | N_Package_Body | N_Subprogram_Body then Decl := First (Declarations (Parent (N))); while Present (Decl) and then Decl /= N loop @@ -2361,8 +2359,7 @@ package body Sem_Ch10 is Remove_Scope; end if; - if Nkind_In (Unit (Lib_Spec), N_Package_Body, - N_Subprogram_Body) + if Nkind (Unit (Lib_Spec)) in N_Package_Body | N_Subprogram_Body then Remove_Context (Library_Unit (Lib_Spec)); end if; @@ -2610,14 +2607,7 @@ package body Sem_Ch10 is -- clauses into regular with clauses. if Sloc (U) /= No_Location then - if In_Predefined_Unit (U) - - -- In ASIS mode the rtsfind mechanism plays no role, and - -- we need to maintain the original tree structure, so - -- this transformation is not performed in this case. - - and then not ASIS_Mode - then + if In_Predefined_Unit (U) then Set_Limited_Present (N, False); Analyze_With_Clause (N); else @@ -2662,9 +2652,8 @@ package body Sem_Ch10 is if Nkind (Nam) = N_Selected_Component and then Nkind (Prefix (Nam)) = N_Identifier and then Chars (Prefix (Nam)) = Name_Gnat - and then Nam_In (Chars (Selector_Name (Nam)), - Name_Most_Recent_Exception, - Name_Exception_Traces) + and then Chars (Selector_Name (Nam)) + in Name_Most_Recent_Exception | Name_Exception_Traces then Check_Restriction (No_Exception_Propagation, N); Special_Exception_Package_Used := True; @@ -2716,7 +2705,7 @@ package body Sem_Ch10 is if Ada_Version < Ada_2020 and then Warn_On_Ada_202X_Compatibility then - Error_Msg_N ("& is an Ada 202X unit?i?", Name (N)); + Error_Msg_N ("& is an Ada 202x unit?i?", Name (N)); end if; end case; end if; @@ -2974,7 +2963,7 @@ package body Sem_Ch10 is -- Start of processing for Check_Private_Child_Unit begin - if Nkind_In (Lib_Unit, N_Package_Body, N_Subprogram_Body) then + if Nkind (Lib_Unit) in N_Package_Body | N_Subprogram_Body then Curr_Unit := Defining_Entity (Unit (Library_Unit (N))); Par_Lib := Curr_Unit; @@ -3081,7 +3070,7 @@ package body Sem_Ch10 is elsif Curr_Private or else Private_Present (Item) - or else Nkind_In (Lib_Unit, N_Package_Body, N_Subunit) + or else Nkind (Lib_Unit) in N_Package_Body | N_Subunit or else (Nkind (Lib_Unit) = N_Subprogram_Body and then not Acts_As_Spec (Parent (Lib_Unit))) then @@ -3108,11 +3097,9 @@ package body Sem_Ch10 is Kind : constant Node_Kind := Nkind (Par); begin - if Nkind_In (Kind, N_Package_Body, - N_Subprogram_Body, - N_Task_Body, - N_Protected_Body) - and then Nkind_In (Parent (Par), N_Compilation_Unit, N_Subunit) + if Kind in + N_Package_Body | N_Subprogram_Body | N_Task_Body | N_Protected_Body + and then Nkind (Parent (Par)) in N_Compilation_Unit | N_Subunit then null; @@ -3204,12 +3191,16 @@ package body Sem_Ch10 is Set_Library_Unit (Withn, Parent (Unit_Declaration_Node (Ent))); Set_Parent_With (Withn); - -- If the unit is a package or generic package declaration, a private_ - -- with_clause on a child unit implies that the implicit with on the - -- parent is also private. + -- If the unit is a [generic] package or subprogram declaration + -- (including a subprogram body acting as spec), a private_with_clause + -- on a child unit implies that the implicit with on the parent is also + -- private. - if Nkind_In (Unit (N), N_Generic_Package_Declaration, - N_Package_Declaration) + if Nkind (Unit (N)) in N_Generic_Package_Declaration + | N_Package_Declaration + | N_Generic_Subprogram_Declaration + | N_Subprogram_Declaration + | N_Subprogram_Body then Set_Private_Present (Withn, Private_Present (Item)); end if; @@ -3718,10 +3709,10 @@ package body Sem_Ch10 is Install_Siblings (Defining_Entity (Unit (Library_Unit (N))), N); end if; - if Nkind_In (Lib_Unit, N_Generic_Package_Declaration, - N_Generic_Subprogram_Declaration, - N_Package_Declaration, - N_Subprogram_Declaration) + if Nkind (Lib_Unit) in N_Generic_Package_Declaration + | N_Generic_Subprogram_Declaration + | N_Package_Declaration + | N_Subprogram_Declaration then if Is_Child_Spec (Lib_Unit) then Lib_Parent := Defining_Entity (Unit (Parent_Spec (Lib_Unit))); @@ -3911,9 +3902,8 @@ package body Sem_Ch10 is elsif Private_Present (Parent (Item)) or else Curr_Private or else Private_Present (Item) - or else Nkind_In (Unit (Parent (Item)), N_Package_Body, - N_Subprogram_Body, - N_Subunit) + or else Nkind (Unit (Parent (Item))) in + N_Package_Body | N_Subprogram_Body | N_Subunit then -- Current unit is private, of descendant of a private unit @@ -4071,9 +4061,8 @@ package body Sem_Ch10 is then if not Private_Present (Item) or else Private_Present (N) - or else Nkind_In (Unit (N), N_Package_Body, - N_Subprogram_Body, - N_Subunit) + or else Nkind (Unit (N)) in + N_Package_Body | N_Subprogram_Body | N_Subunit then Install_Limited_With_Clause (Item); end if; @@ -4165,9 +4154,9 @@ package body Sem_Ch10 is end if; if Ekind (P_Name) = E_Generic_Package - and then not Nkind_In (Lib_Unit, N_Generic_Subprogram_Declaration, - N_Generic_Package_Declaration) - and then Nkind (Lib_Unit) not in N_Generic_Renaming_Declaration + and then Nkind (Lib_Unit) not in N_Generic_Subprogram_Declaration + | N_Generic_Package_Declaration + | N_Generic_Renaming_Declaration then Error_Msg_N ("child of a generic package must be a generic unit", Lib_Unit); @@ -4630,17 +4619,17 @@ package body Sem_Ch10 is -- Save for subsequent examination of import pragmas. if Comes_From_Source (Decl) - and then (Nkind_In (Decl, N_Subprogram_Declaration, - N_Subprogram_Renaming_Declaration, - N_Generic_Subprogram_Declaration)) + and then (Nkind (Decl) in N_Subprogram_Declaration + | N_Subprogram_Renaming_Declaration + | N_Generic_Subprogram_Declaration) then Append_Elmt (Defining_Entity (Decl), Subp_List); -- Package declaration of generic package declaration. We need -- to recursively examine nested declarations. - elsif Nkind_In (Decl, N_Package_Declaration, - N_Generic_Package_Declaration) + elsif Nkind (Decl) in N_Package_Declaration + | N_Generic_Package_Declaration then Check_Declarations (Specification (Decl)); @@ -4660,14 +4649,14 @@ package body Sem_Ch10 is Decl := First (Private_Declarations (Spec)); while Present (Decl) loop if Comes_From_Source (Decl) - and then (Nkind_In (Decl, N_Subprogram_Declaration, - N_Subprogram_Renaming_Declaration, - N_Generic_Subprogram_Declaration)) + and then Nkind (Decl) in N_Subprogram_Declaration + | N_Subprogram_Renaming_Declaration + | N_Generic_Subprogram_Declaration then Append_Elmt (Defining_Entity (Decl), Subp_List); - elsif Nkind_In (Decl, N_Package_Declaration, - N_Generic_Package_Declaration) + elsif Nkind (Decl) in N_Package_Declaration + | N_Generic_Package_Declaration then Check_Declarations (Specification (Decl)); @@ -4902,8 +4891,8 @@ package body Sem_Ch10 is -- corresponding spec, otherwise follow pointer to parent spec. if Present (Library_Unit (Aux_Unit)) - and then Nkind_In (Unit (Aux_Unit), - N_Package_Body, N_Subprogram_Body) + and then Nkind (Unit (Aux_Unit)) in + N_Package_Body | N_Subprogram_Body then if Aux_Unit = Library_Unit (Aux_Unit) then @@ -5273,9 +5262,8 @@ package body Sem_Ch10 is -- Set entity of parent identifiers if the unit is a child -- unit. This ensures that the tree is properly formed from - -- semantic point of view (e.g. for ASIS queries). The unit - -- entities are not fully analyzed, so we need to follow unit - -- links in the tree. + -- semantic point of view. The unit entities are not fully + -- analyzed, so we need to follow unit links in the tree. Set_Entity (Nam, Ent); @@ -5555,7 +5543,7 @@ package body Sem_Ch10 is E1 : constant Entity_Id := Defining_Entity (Unit (U1)); E2 : Entity_Id; begin - if Nkind_In (Unit (U2), N_Package_Body, N_Subprogram_Body) then + if Nkind (Unit (U2)) in N_Package_Body | N_Subprogram_Body then E2 := Defining_Entity (Unit (Library_Unit (U2))); return Is_Ancestor_Package (E1, E2); else @@ -6062,12 +6050,12 @@ package body Sem_Ch10 is -- Types - elsif Nkind_In (Decl, N_Full_Type_Declaration, - N_Incomplete_Type_Declaration, - N_Private_Extension_Declaration, - N_Private_Type_Declaration, - N_Protected_Type_Declaration, - N_Task_Type_Declaration) + elsif Nkind (Decl) in N_Full_Type_Declaration + | N_Incomplete_Type_Declaration + | N_Private_Extension_Declaration + | N_Private_Type_Declaration + | N_Protected_Type_Declaration + | N_Task_Type_Declaration then Def_Id := Defining_Entity (Decl); @@ -6086,8 +6074,8 @@ package body Sem_Ch10 is (Nkind (Def) = N_Derived_Type_Definition and then Present (Record_Extension_Part (Def))); - elsif Nkind_In (Decl, N_Incomplete_Type_Declaration, - N_Private_Type_Declaration) + elsif Nkind (Decl) in N_Incomplete_Type_Declaration + | N_Private_Type_Declaration then Is_Tagged := Tagged_Present (Decl); @@ -6317,7 +6305,7 @@ package body Sem_Ch10 is if Is_Subprogram (E) and then Has_Pragma_Inline (E) then return True; - elsif Ekind_In (E, E_Generic_Function, E_Generic_Procedure) then + elsif Is_Generic_Subprogram (E) then -- A generic subprogram always requires the presence of its -- body because an instantiation needs both templates. The only @@ -6369,7 +6357,7 @@ package body Sem_Ch10 is then Set_Body_Needed_For_SAL (Unit_Name); - elsif Ekind_In (Unit_Name, E_Generic_Procedure, E_Generic_Function) then + elsif Ekind (Unit_Name) in E_Generic_Procedure | E_Generic_Function then Set_Body_Needed_For_SAL (Unit_Name); elsif Is_Subprogram (Unit_Name) @@ -6865,7 +6853,7 @@ package body Sem_Ch10 is -- as a small optimization to subsequent handling of private_with -- clauses in other nested packages. We replace the clause with -- a null statement, which is otherwise ignored by the rest of - -- the compiler, so that ASIS tools can reconstruct the source. + -- the compiler. if In_Regular_With_Clause (Entity (Name (Item))) then declare |