From: Piotr Trojanek <trojanek@adacore.com>
Date: Tue, 6 Sep 2022 18:11:35 +0000 (+0200)
Subject: [Ada] Reject 'Valid_Scalars on Unchecked_Union regardless of privacy
X-Git-Tag: basepoints/gcc-14~4595
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=0c960fef5d660b7c01264ac15d2314a146a52987;p=thirdparty%2Fgcc.git

[Ada] Reject 'Valid_Scalars on Unchecked_Union regardless of privacy

Attribute Valid_Scalars applied to prefix with an unchecked union
component causes a legitimate crash in the backend. It was already
rejected in the frontend for prefixes of a public type; now it is
rejected in the frontend regardless of the type privacy.

gcc/ada/

	* sem_attr.adb (Analyze_Attribute [Valid_Scalars]): Move check for
	unchecked union before checks for private and public types.
---

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index f33da069207f..0c88be71b944 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -7399,10 +7399,19 @@ package body Sem_Attr is
          if Comes_From_Source (N) then
             Check_Object_Reference (P);
 
+            --  Attribute 'Valid_Scalars is illegal on unchecked union types
+            --  regardles of the privacy, because it is not always guaranteed
+            --  that the components are retrievable based on whether the
+            --  discriminants are inferable.
+
+            if Has_Unchecked_Union (Validated_View (P_Type)) then
+               Error_Attr_P
+                 ("attribute % not allowed for Unchecked_Union type");
+
             --  Do not emit any diagnostics related to private types to avoid
             --  disclosing the structure of the type.
 
-            if Is_Private_Type (P_Type) then
+            elsif Is_Private_Type (P_Type) then
 
                --  Attribute 'Valid_Scalars is not supported on private tagged
                --  types due to a code generation issue. Is_Visible_Component
@@ -7432,15 +7441,6 @@ package body Sem_Attr is
                     ("??attribute % always True, no scalars to check", P);
                   Set_Boolean_Result (N, True);
                end if;
-
-               --  Attribute 'Valid_Scalars is illegal on unchecked union types
-               --  because it is not always guaranteed that the components are
-               --  retrievable based on whether the discriminants are inferable
-
-               if Has_Unchecked_Union (P_Type) then
-                  Error_Attr_P
-                    ("attribute % not allowed for Unchecked_Union type");
-               end if;
             end if;
          end if;