From: Javier Miranda <mira...@adacore.com> 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. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/checks.adb | 2 +- gcc/ada/exp_util.adb | 15 +++++++++++++++ gcc/ada/exp_util.ads | 5 +++++ gcc/ada/sem_util.adb | 4 ++++ 4 files changed, 25 insertions(+), 1 deletion(-) diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 38fe687bc7a..77043ca07c2 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 ef8c91dfe94..392bf3a511e 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 14d9e345b53..279feb2e6fe 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 3f956098c6d..ab7fcf8dfd1 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. -- 2.45.2