diff options
| author | Gary Dismukes <dismukes@adacore.com> | 2021-12-17 18:41:01 -0500 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2022-01-11 13:24:46 +0000 |
| commit | a115e497e64731bada3b8aeab2f9444c638a145f (patch) | |
| tree | a2c91c819164614e7bfb19bf0bd4a5a114ec3680 /gcc/ada/sem_disp.adb | |
| parent | e5be83512a66369ae77c9652d3a3073a14ff466a (diff) | |
| download | gcc-a115e497e64731bada3b8aeab2f9444c638a145f.zip gcc-a115e497e64731bada3b8aeab2f9444c638a145f.tar.gz gcc-a115e497e64731bada3b8aeab2f9444c638a145f.tar.bz2 | |
[Ada] Conformance error on protected subp with anonymous-access-to-tagged formal
gcc/ada/
* sem_disp.adb (Check_Controlling_Type): Add test for the case
where Subp is a subprogram associated with a protected
subprogram and return Empty, unless Tagged_Type is the
corresponding record type of the protected type.
Diffstat (limited to 'gcc/ada/sem_disp.adb')
| -rw-r--r-- | gcc/ada/sem_disp.adb | 23 |
1 files changed, 23 insertions, 0 deletions
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index 73d0e9d..cafe2c3 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -478,6 +478,29 @@ package body Sem_Disp is if No (Tagged_Type) or else Is_Class_Wide_Type (Tagged_Type) then return Empty; + -- In the special case of a protected subprogram of a tagged protected + -- type that has a formal of a tagged type (or access formal whose type + -- designates a tagged type), such a formal is not controlling unless + -- it's of the protected type's corresponding record type. The latter + -- can occur for the special wrapper subprograms created for protected + -- subprograms. Such subprograms may occur in the same scope where some + -- formal's tagged type is declared, and we don't want formals of that + -- tagged type being marked as controlling, for one thing because they + -- aren't controlling from the language point of view, but also because + -- this can cause errors for access formals when conformance is checked + -- between the spec and body of the protected subprogram (null-exclusion + -- status of the formals may be set differently, which is the case that + -- led to adding this check). + + elsif Is_Subprogram (Subp) + and then Present (Protected_Subprogram (Subp)) + and then Ekind (Scope (Protected_Subprogram (Subp))) = E_Protected_Type + and then + Base_Type (Tagged_Type) + /= Corresponding_Record_Type (Scope (Protected_Subprogram (Subp))) + then + return Empty; + -- The dispatching type and the primitive operation must be defined in -- the same scope, except in the case of internal operations and formal -- abstract subprograms. |