[gcc r17-792] ada: Fix long-standing issue with qualified expressions of class-wide types

[Marc Poulhies]

https://gcc.gnu.org/g:6a23ada5e3cd2c2757dfcd9779fb3dd1e5eaec57

commit r17-792-g6a23ada5e3cd2c2757dfcd9779fb3dd1e5eaec57
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Tue Feb 10 20:09:59 2026 +0100

    ada: Fix long-standing issue with qualified expressions of class-wide types
    
    Given the very specific name resolution rules for qualified expressions, the
    Covers predicate cannot be used when the qualified expression is of a class-
    wide type and, therefore, Analyze_Qualified_Expression needs to resort to a
    stricter type compatibility analysis. But, unlike Covers, it fails to factor
    out the limited views of the types, which may lead to spurious errors.
    
    gcc/ada/ChangeLog:
    
            * sem_ch4.adb (Analyze_Qualified_Expression): For a class-wide type,
            check for an exact match modulo the Non_Limited_View attribute.

Diff:
---
 gcc/ada/sem_ch4.adb | 37 ++++++++++++++++++++++++++++++++-----
 1 file changed, 32 insertions(+), 5 deletions(-)

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 956b25fbdd0d..d6b56b4c6d56 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -4528,9 +4528,36 @@ package body Sem_Ch4 is
       Expr : constant Node_Id   := Expression (N);
       Mark : constant Entity_Id := Subtype_Mark (N);
 
-      I    : Interp_Index;
-      It   : Interp;
-      T    : Entity_Id;
+      function Same_Class_Wide_Type (Typ, CW_Typ : Entity_Id) return Boolean;
+      --  Return whether Typ is the same class-wide type as CW_Typ. This is
+      --  essentially an equality test modulo the Non_Limited_View attribute.
+
+      --------------------------
+      -- Same_Class_Wide_Type --
+      --------------------------
+
+      function Same_Class_Wide_Type (Typ, CW_Typ : Entity_Id) return Boolean is
+         Btyp : constant Entity_Id := Base_Type (Typ);
+
+      begin
+         if Ekind (Btyp) /= E_Class_Wide_Type then
+            return False;
+         end if;
+
+         if Has_Non_Limited_View (Btyp) then
+            return Non_Limited_View (Btyp) = Base_Type (CW_Typ);
+         else
+            return Btyp = Base_Type (CW_Typ);
+         end if;
+      end Same_Class_Wide_Type;
+
+      --  Local variables
+
+      I  : Interp_Index;
+      It : Interp;
+      T  : Entity_Id;
+
+   --  Start of processing for Analyze_Qualified_Expression
 
    begin
       Find_Type (Mark);
@@ -4569,7 +4596,7 @@ package body Sem_Ch4 is
 
       if Is_Class_Wide_Type (T) then
          if not Is_Overloaded (Expr) then
-            if Base_Type (Etype (Expr)) /= Base_Type (T)
+            if not Same_Class_Wide_Type (Etype (Expr), T)
               and then Etype (Expr) /= Raise_Type
             then
                if Nkind (Expr) = N_Aggregate then
@@ -4583,7 +4610,7 @@ package body Sem_Ch4 is
             Get_First_Interp (Expr, I, It);
 
             while Present (It.Nam) loop
-               if Base_Type (It.Typ) /= Base_Type (T) then
+               if not Same_Class_Wide_Type (It.Typ, T) then
                   Remove_Interp (I);
                end if;