diff options
| author | Javier Miranda <miranda@adacore.com> | 2024-08-05 15:56:33 +0000 |
|---|---|---|
| committer | Marc Poulhiès <dkm@gcc.gnu.org> | 2024-08-23 10:51:03 +0200 |
| commit | aa95cd98575bd25e211d4ef0a025844575e752b4 (patch) | |
| tree | 0e7c6836253bb49fbc92259b360b2bbfadf0adfa /gcc | |
| parent | 8a41af72e060b150df3ce8a77120705155cb698e (diff) | |
| download | gcc-aa95cd98575bd25e211d4ef0a025844575e752b4.zip gcc-aa95cd98575bd25e211d4ef0a025844575e752b4.tar.gz gcc-aa95cd98575bd25e211d4ef0a025844575e752b4.tar.bz2 | |
ada: Error missing when 'access is applied to an interface type object
The compiler does not report an error when 'access is applied to
a non-aliased class-wide interface type object.
gcc/ada/
* exp_util.ads (Is_Expanded_Class_Wide_Interface_Object_Decl): New
subprogram.
* exp_util.adb (Is_Expanded_Class_Wide_Interface_Object_Decl):
ditto.
* sem_util.adb (Is_Aliased_View): Handle expanded class-wide type
object declaration.
* checks.adb (Is_Aliased_Unconstrained_Component): Protect the
frontend against calling Is_Aliased_View with Empty. Found working
on this issue.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/checks.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/exp_util.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/exp_util.ads | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 4 |
4 files changed, 25 insertions, 1 deletions
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 38fe687..77043ca 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -1549,7 +1549,7 @@ package body Checks is then if (Etype (N) = Typ or else (Do_Access and then Designated_Type (Typ) = S_Typ)) - and then not Is_Aliased_View (Lhs) + and then (No (Lhs) or else not Is_Aliased_View (Lhs)) then return; end if; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index ef8c91d..392bf3a 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -8574,6 +8574,21 @@ package body Exp_Util is and then Is_Formal (Entity (N))); end Is_Conversion_Or_Reference_To_Formal; + -------------------------------------------------- + -- Is_Expanded_Class_Wide_Interface_Object_Decl -- + -------------------------------------------------- + + function Is_Expanded_Class_Wide_Interface_Object_Decl + (N : Node_Id) return Boolean is + begin + return not Comes_From_Source (N) + and then Nkind (Original_Node (N)) = N_Object_Declaration + and then Nkind (N) = N_Object_Renaming_Declaration + and then Is_Class_Wide_Type (Etype (Defining_Identifier (N))) + and then Is_Interface (Etype (Defining_Identifier (N))) + and then Nkind (Name (N)) = N_Explicit_Dereference; + end Is_Expanded_Class_Wide_Interface_Object_Decl; + ------------------------------ -- Is_Finalizable_Transient -- ------------------------------ diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 14d9e34..279feb2 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -773,6 +773,11 @@ package Exp_Util is -- Return True if N is a type conversion, or a dereference thereof, or a -- reference to a formal parameter. + function Is_Expanded_Class_Wide_Interface_Object_Decl + (N : Node_Id) return Boolean; + -- Determine if N is the expanded code for a class-wide interface type + -- object declaration. + function Is_Finalizable_Transient (Decl : Node_Id; N : Node_Id) return Boolean; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 3f95609..ab7fcf8 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -15223,6 +15223,10 @@ package body Sem_Util is then return Is_Aliased_View (Expression (Obj)); + elsif Is_Expanded_Class_Wide_Interface_Object_Decl (Parent (Obj)) then + return Is_Aliased + (Defining_Identifier (Original_Node (Parent (Obj)))); + -- The dereference of an access-to-object value denotes an aliased view, -- but this routine uses the rules of the language so we need to exclude -- rewritten constructs that introduce artificial dereferences. |