diff options
| -rw-r--r-- | gcc/ada/sem_ch13.adb | 4 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 35 | ||||
| -rw-r--r-- | gcc/ada/sem_util.ads | 15 |
3 files changed, 40 insertions, 14 deletions
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 9ece773..d1458f5 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -133,9 +133,7 @@ package body Sem_Ch13 is function Build_Predicate_Function_Declaration (Typ : Entity_Id) return Node_Id; -- Build the declaration for a predicate function. The declaration is built - -- at the end of the declarative part containing the type definition, which - -- may be before the freeze point of the type. The predicate expression is - -- preanalyzed at this point, to catch visibility errors. + -- at the same time as the body but inserted before, as explained below. procedure Build_Predicate_Function (Typ : Entity_Id; N : Node_Id); -- If Typ has predicates (indicated by Has_Predicates being set for Typ), diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 391cade..c8599d4 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -312,11 +312,12 @@ package body Sem_Util is -------------------------- procedure Add_Block_Identifier - (N : Node_Id; - Id : out Entity_Id; - Scope : Entity_Id := Current_Scope) + (N : Node_Id; + Id : out Entity_Id; + Scope : Entity_Id := Current_Scope) is Loc : constant Source_Ptr := Sloc (N); + begin pragma Assert (Nkind (N) = N_Block_Statement); @@ -331,7 +332,6 @@ package body Sem_Util is Id := New_Internal_Entity (E_Block, Scope, Loc, 'B'); Set_Etype (Id, Standard_Void_Type); Set_Parent (Id, N); - Set_Identifier (N, New_Occurrence_Of (Id, Loc)); Set_Block_Node (Id, Identifier (N)); end if; @@ -6721,6 +6721,31 @@ package body Sem_Util is return S; end Current_Scope_No_Loops; + -------------------------------------- + -- Current_Scope_No_Loops_No_Blocks -- + -------------------------------------- + + function Current_Scope_No_Loops_No_Blocks return Entity_Id is + S : Entity_Id; + + begin + -- Examine the scope stack starting from the current scope and skip any + -- internally generated loops and blocks. + + S := Current_Scope; + while Present (S) and then S /= Standard_Standard loop + if Ekind (S) in E_Loop | E_Block + and then not Comes_From_Source (S) + then + S := Scope (S); + else + exit; + end if; + end loop; + + return S; + end Current_Scope_No_Loops_No_Blocks; + ------------------------ -- Current_Subprogram -- ------------------------ @@ -27724,7 +27749,7 @@ package body Sem_Util is ----------------------- procedure Set_Public_Status (Id : Entity_Id) is - S : constant Entity_Id := Current_Scope; + S : constant Entity_Id := Current_Scope_No_Loops_No_Blocks; function Within_HSS_Or_If (E : Entity_Id) return Boolean; -- Determines if E is defined within handled statement sequence or diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 7bb8cdb..3edc158 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -639,18 +639,21 @@ package Sem_Util is function Current_Scope return Entity_Id; -- Get entity representing current scope + function Current_Scope_No_Loops return Entity_Id; + -- Return the current scope ignoring internally generated loops + + function Current_Scope_No_Loops_No_Blocks return Entity_Id; + -- Return the current scope ignoring internally generated loops and blocks + procedure Add_Block_Identifier - (N : Node_Id; - Id : out Entity_Id; - Scope : Entity_Id := Current_Scope); + (N : Node_Id; + Id : out Entity_Id; + Scope : Entity_Id := Current_Scope); -- Given a block statement N, generate an internal E_Block label and make -- it the identifier of the block. Scope denotes the scope in which the -- generated entity Id is created and defaults to the current scope. If the -- block already has an identifier, Id returns the entity of its label. - function Current_Scope_No_Loops return Entity_Id; - -- Return the current scope ignoring internally generated loops - function Current_Subprogram return Entity_Id; -- Returns current enclosing subprogram. If Current_Scope is a subprogram, -- then that is what is returned, otherwise the Enclosing_Subprogram of the |