diff options
| author | Gary Dismukes <dismukes@adacore.com> | 2020-06-15 17:14:14 -0400 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-07-27 04:05:16 -0400 |
| commit | faa163f737cb388f97a285be28060730abd460a0 (patch) | |
| tree | 7af92930374a8f30e3d503d72b6f79b29110bfe5 /gcc/ada | |
| parent | df81923f6d805ebf390e116b1902d0c8ec93c477 (diff) | |
| download | gcc-faa163f737cb388f97a285be28060730abd460a0.zip gcc-faa163f737cb388f97a285be28060730abd460a0.tar.gz gcc-faa163f737cb388f97a285be28060730abd460a0.tar.bz2 | |
[Ada] AI12-0382: Loosen type-invariant overriding requirement of AI12-0042
gcc/ada/
* sem_ch3.adb (Check_Abstract_Overriding): Remove Scope
comparison test from test related to initial implementation of
AI12-0042, plus remove the related ??? comment.
(Derive_Subprogram): Add test requiring that the type extension
appear in the visible part of its enclosing package when
checking the overriding requirement of 7.3.2(6.1/4), as
clarified by AI12-0382.
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/sem_ch3.adb | 15 |
1 files changed, 6 insertions, 9 deletions
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 5f92a77..6cc315c 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -10763,12 +10763,7 @@ package body Sem_Ch3 is -- AI12-0042: Test for rule in 7.3.2(6.1/4), that requires overriding -- of a visible private primitive inherited from an ancestor with -- the aspect Type_Invariant'Class, unless the inherited primitive - -- is abstract. (The test for the extension occurring in a different - -- scope than the ancestor is to avoid requiring overriding when - -- extending in the same scope, because the inherited primitive will - -- also be private in that case, which looks like an unhelpful - -- restriction that may break reasonable code, though the rule - -- appears to apply in the same-scope case as well???) + -- is abstract. elsif not Is_Abstract_Subprogram (Subp) and then not Comes_From_Source (Subp) -- An inherited subprogram @@ -10778,7 +10773,6 @@ package body Sem_Ch3 is and then Present (Get_Pragma (Etype (T), Pragma_Invariant)) and then Class_Present (Get_Pragma (Etype (T), Pragma_Invariant)) and then Is_Private_Primitive (Alias_Subp) - and then Scope (Subp) /= Scope (Alias_Subp) then Error_Msg_NE ("inherited private primitive & must be overridden", T, Subp); @@ -15732,7 +15726,9 @@ package body Sem_Ch3 is -- AI12-0042: Set Requires_Overriding when a type extension -- inherits a private operation that is visible at the -- point of extension (Has_Private_Ancestor is False) from - -- an ancestor that has Type_Invariant'Class. + -- an ancestor that has Type_Invariant'Class, and when the + -- type extension is in a visible part (the latter as + -- clarified by AI12-0382). or else (not Has_Private_Ancestor (Derived_Type) @@ -15742,7 +15738,8 @@ package body Sem_Ch3 is and then Class_Present (Get_Pragma (Parent_Type, Pragma_Invariant)) - and then Is_Private_Primitive (Parent_Subp))) + and then Is_Private_Primitive (Parent_Subp) + and then In_Visible_Part (Scope (Derived_Type)))) and then No (Actual_Subp) then |