diff options
Diffstat (limited to 'gcc/ada/sem_util.adb')
| -rw-r--r-- | gcc/ada/sem_util.adb | 153 |
1 files changed, 150 insertions, 3 deletions
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 4e3c625..74de26a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -52,6 +52,7 @@ with Sem_Attr; use Sem_Attr; with Sem_Cat; use Sem_Cat; with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; +with Sem_Ch12; use Sem_Ch12; with Sem_Ch13; use Sem_Ch13; with Sem_Dim; use Sem_Dim; with Sem_Disp; use Sem_Disp; @@ -12837,6 +12838,150 @@ package body Sem_Util is return False; end Has_Overriding_Initialize; + ----------------------------- + -- Has_Potentially_Invalid -- + ----------------------------- + + function Has_Potentially_Invalid (E : Entity_Id) return Boolean is + + function Denotes_Invalid_Parameter + (Expr : Node_Id; + Param : Entity_Id) + return Boolean; + -- Returns True iff expression Expr denotes a formal parameter or + -- function Param (through its attribute Result). + + ------------------------------- + -- Denotes_Invalid_Parameter -- + ------------------------------- + + function Denotes_Invalid_Parameter + (Expr : Node_Id; + Param : Entity_Id) return Boolean is + begin + if Nkind (Expr) in N_Identifier | N_Expanded_Name then + return Entity (Expr) = Param; + else + pragma Assert (Is_Attribute_Result (Expr)); + return Entity (Prefix (Expr)) = Param; + end if; + end Denotes_Invalid_Parameter; + + -- Start of processing for Has_Potentially_Invalid + + begin + -- When analyzing, we checked all syntax legality rules for the aspect + -- Potentially_Invalid, but didn't store the property anywhere (e.g. as + -- an Einfo flag). To query the property we look directly at the AST, + -- but now without any syntactic checks. + + case Ekind (E) is + -- Constants have this aspect attached directly; for deferred + -- constants, the aspect is attached to the partial view. + + when E_Constant => + return Has_Aspect (E, Aspect_Potentially_Invalid); + + -- Variables have this aspect attached directly + + when E_Variable => + return Has_Aspect (E, Aspect_Potentially_Invalid); + + when Formal_Kind + | E_Function + => + -- Instances of Ada.Unchecked_Conversion is a special case. Look + -- for the aspect on the generic instance. The aspect necessarily + -- applies to the function result. + + if Is_Unchecked_Conversion_Instance (E) then + declare + Wrapper_Pkg : constant Node_Id := + Defining_Unit_Name (Parent (Subprogram_Spec (E))); + pragma Assert (Is_Wrapper_Package (Wrapper_Pkg)); + Instance : constant Entity_Id := Defining_Unit_Name + (Get_Unit_Instantiation_Node (Wrapper_Pkg)); + begin + return Has_Aspect (Instance, Aspect_Potentially_Invalid); + end; + end if; + + -- Formal parameters and functions have the Potentially_Invalid + -- aspect attached to the subprogram entity and must be listed in + -- the aspect expression. + + declare + Subp_Id : Entity_Id; + Aspect_Expr : Node_Id; + Param_Expr : Node_Id; + Assoc : Node_Id; + + begin + if Is_Formal (E) then + Subp_Id := Scope (E); + else + Subp_Id := E; + end if; + + if Has_Aspect (Subp_Id, Aspect_Potentially_Invalid) then + Aspect_Expr := + Find_Value_Of_Aspect + (Subp_Id, Aspect_Potentially_Invalid); + + -- Aspect expression is either an aggregate with an optional + -- Boolean expression (which defaults to True), e.g.: + -- + -- function F (X : Integer) return Integer + -- with Potentially_Invalid => (X => True, F'Result); + + if Nkind (Aspect_Expr) = N_Aggregate then + + if Present (Component_Associations (Aspect_Expr)) then + Assoc := First (Component_Associations (Aspect_Expr)); + + while Present (Assoc) loop + if Denotes_Invalid_Parameter + (First (Choices (Assoc)), E) + then + return + Is_True + (Static_Boolean (Expression (Assoc))); + end if; + + Next (Assoc); + end loop; + end if; + + Param_Expr := First (Expressions (Aspect_Expr)); + + while Present (Param_Expr) loop + if Denotes_Invalid_Parameter (Param_Expr, E) then + return True; + end if; + + Next (Param_Expr); + end loop; + + return False; + + -- or it is a single identifier, e.g.: + -- + -- function F (X : Integer) return Integer + -- with Potentially_Invalid => X; + + else + return Denotes_Invalid_Parameter (Aspect_Expr, E); + end if; + else + return False; + end if; + end; + + when others => + raise Program_Error; + end case; + end Has_Potentially_Invalid; + -------------------------------------- -- Has_Preelaborable_Initialization -- -------------------------------------- @@ -23967,7 +24112,7 @@ package body Sem_Util is Result := N; - if N > Empty_Or_Error then + if N not in Empty | Error then pragma Assert (Nkind (N) not in N_Entity); Result := New_Copy (N); @@ -24048,7 +24193,7 @@ package body Sem_Util is Result := Id; - if Id > Empty_Or_Error then + if Id not in Empty | Error then pragma Assert (Nkind (Id) in N_Entity); -- Determine whether the entity has a corresponding new entity @@ -24162,7 +24307,9 @@ package body Sem_Util is Next (Old_Act); end loop; - pragma Assert (Replaced); + if Nkind (Old_Call) /= N_Function_Call then + pragma Assert (Replaced); + end if; end Update_Controlling_Argument; ------------------------------- |