https://gcc.gnu.org/g:fc2164a2168b8c80bad5bac69e2ebc03f904e89f

commit r17-1292-gfc2164a2168b8c80bad5bac69e2ebc03f904e89f
Author: Eric Botcazou <[email protected]>
Date:   Wed May 6 18:52:59 2026 +0200

    ada: Fix fallout of latest change to Valid_Scalars attribute
    
    The attribute does not work for all private tagged types, but this was not
    detected in the case where the full view alone is tagged.
    
    gcc/ada/ChangeLog:
    
            PR ada/124923
            * exp_attr.adb  (Expand_N_Attribute_Reference) <Valid_Scalars>: Also
            bail out for a private type whose full view alone is tagged.
            * sem_attr.adb (Analyze_Attribute) <Valid_Scalars>: Also warn for a
            private type whose only full view alone is tagged.

Diff:
---
 gcc/ada/exp_attr.adb | 6 +++++-
 gcc/ada/sem_attr.adb | 5 ++++-
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 3b56f3cb99e2..1834ee3d291e 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -8636,7 +8636,11 @@ package body Exp_Attr is
          --  Attribute 'Valid_Scalars is not supported on private tagged types;
          --  see a detailed explanation where this attribute is analyzed.
 
-         if Is_Tagged_Type (Ptyp) and then Is_Private_Type (Ptyp) then
+         if Is_Private_Type (Ptyp)
+           and then (Is_Tagged_Type (Ptyp)
+                      or else (Present (Full_View (Ptyp))
+                                and then Is_Tagged_Type (Full_View (Ptyp))))
+         then
             null;
 
          elsif Is_Class_Wide_Type (Ptyp)
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 709f4f2e3f97..86deb65552b8 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -7857,7 +7857,10 @@ package body Sem_Attr is
                --  in turn prevents the proper expansion of the attribute into
                --  True.
 
-               if Is_Tagged_Type (P_Type) then
+               if Is_Tagged_Type (P_Type)
+                 or else (Present (Full_View (P_Type))
+                           and then Is_Tagged_Type (Full_View (P_Type)))
+               then
                   Error_Msg_Name_1 := Aname;
                   Error_Msg_N ("??effects of attribute % are ignored", N);
                end if;

Reply via email to