diff options
Diffstat (limited to 'gcc/ada/sem_util.adb')
| -rw-r--r-- | gcc/ada/sem_util.adb | 44 |
1 files changed, 34 insertions, 10 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 1764da9db02..edf1fecbfe6 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2437,6 +2437,12 @@ package body Sem_Util is (Defining_Identifier (Associated_Node_For_Itype (Typ)))); + -- For generic formal type, return Int'Last (infinite). + -- See comment preceding Is_Generic_Type call in Type_Access_Level. + + elsif Is_Generic_Type (Root_Type (Typ)) then + return UI_From_Int (Int'Last); + else return Type_Access_Level (Typ); end if; @@ -6583,10 +6589,6 @@ package body Sem_Util is if Is_Entity_Name (Obj) then E := Entity (Obj); - if Is_Object (E) and then not Is_Aliased (E) then - Check_Restriction (No_Implicit_Aliasing, Obj); - end if; - return (Is_Object (E) and then @@ -8731,10 +8733,15 @@ package body Sem_Util is then return True; - elsif Nkind (N) = N_Indexed_Component - or else Nkind (N) = N_Selected_Component + elsif Nkind_In (N, N_Indexed_Component, N_Selected_Component) + and then Is_Volatile_Prefix (Prefix (N)) then - return Is_Volatile_Prefix (Prefix (N)); + return True; + + elsif Nkind (N) = N_Selected_Component + and then Is_Volatile (Entity (Selector_Name (N))) + then + return True; else return False; @@ -10837,9 +10844,7 @@ package body Sem_Util is -- source. This excludes, for example, calls to a dispatching -- assignment operation when the left-hand side is tagged. - if Modification_Comes_From_Source - or else Alfa_Mode - then + if Modification_Comes_From_Source or else Alfa_Mode then Generate_Reference (Ent, Exp, 'm'); -- If the target of the assignment is the bound variable @@ -12715,6 +12720,25 @@ package body Sem_Util is end if; end if; + -- Return library level for a generic formal type. This is done because + -- RM(10.3.2) says that "The statically deeper relationship does not + -- apply to ... a descendant of a generic formal type". Rather than + -- checking at each point where a static accessibility check is + -- performed to see if we are dealing with a formal type, this rule is + -- implemented by having Type_Access_Level and Deepest_Type_Access_Level + -- return extreme values for a formal type; Deepest_Type_Access_Level + -- returns Int'Last. By calling the appropriate function from among the + -- two, we ensure that the static accessibility check will pass if we + -- happen to run into a formal type. More specifically, we should call + -- Deepest_Type_Access_Level instead of Type_Access_Level whenever the + -- call occurs as part of a static accessibility check and the error + -- case is the case where the type's level is too shallow (as opposed + -- to too deep). + + if Is_Generic_Type (Root_Type (Btyp)) then + return Scope_Depth (Standard_Standard); + end if; + return Scope_Depth (Enclosing_Dynamic_Scope (Btyp)); end Type_Access_Level; |