diff options
Diffstat (limited to 'gcc/ada/sem_ch7.adb')
| -rw-r--r-- | gcc/ada/sem_ch7.adb | 47 |
1 files changed, 33 insertions, 14 deletions
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 4d0bf159b3e..8af1f346ebc 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -1482,7 +1482,7 @@ package body Sem_Ch7 is end if; -- If invariants are present, build the invariant procedure for a - -- private type, but not any of its subtypes. + -- private type, but not any of its subtypes or interface types. if Has_Invariants (E) then if Ekind (E) = E_Private_Subtype then @@ -1665,23 +1665,42 @@ package body Sem_Ch7 is if Is_Type (E) and then Has_Private_Declaration (E) and then Nkind (Parent (E)) = N_Full_Type_Declaration - and then Has_Aspects (Parent (E)) then declare - ASN : Node_Id; + IP_Built : Boolean := False; begin - ASN := First (Aspect_Specifications (Parent (E))); - while Present (ASN) loop - if Nam_In (Chars (Identifier (ASN)), Name_Invariant, - Name_Type_Invariant) - then - Build_Invariant_Procedure (E, N); - exit; - end if; + if Has_Aspects (Parent (E)) then + declare + ASN : Node_Id; + + begin + ASN := First (Aspect_Specifications (Parent (E))); + while Present (ASN) loop + if Nam_In (Chars (Identifier (ASN)), + Name_Invariant, + Name_Type_Invariant) + then + Build_Invariant_Procedure (E, N); + IP_Built := True; + exit; + end if; - Next (ASN); - end loop; + Next (ASN); + end loop; + end; + end if; + + -- Invariants may have been inherited from progenitors + + if not IP_Built + and then Has_Interfaces (E) + and then Has_Inheritable_Invariants (E) + and then not Is_Interface (E) + and then not Is_Class_Wide_Type (E) + then + Build_Invariant_Procedure (E, N); + end if; end; end if; @@ -1987,7 +2006,7 @@ package body Sem_Ch7 is and then Present (DTC_Entity (Alias (Prim_Op))) then Set_DTC_Entity_Value (E, New_Op); - Set_DT_Position (New_Op, + Set_DT_Position_Value (New_Op, DT_Position (Alias (Prim_Op))); end if; |