From: Steve Baird <baird@adacore.com>
Date: Wed, 8 May 2024 00:04:28 +0000 (-0700)
Subject: ada: Bad tree built for Obj.Discrim_Dep_Component'Loop_Entry in assertion
X-Git-Tag: basepoints/gcc-16~8234
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=5d429a206c0784435cf963cbfd645cb4e7733795;p=thirdparty%2Fgcc.git

ada: Bad tree built for Obj.Discrim_Dep_Component'Loop_Entry in assertion

The Etype for an N_Selected_Component node usually should not match the Etype
of the referenced component if the component is subject to a
discriminant-dependent constraint. Instead Build_Actual_Subtype_Of_Component
should be called. Fix a case where this rule was not being followed (because
B_A_S_O_C is not called during preanalysis of a component selection), resulting
in a tree that confused CodePeer because the subtype was wrong.

gcc/ada/

	* exp_attr.adb
	(Expand_Loop_Entry_Attribute):
	Ensure that Etype of the saved expression is set correctly.
---

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 1396007a2d1..5c85b4912d2 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -1780,14 +1780,25 @@ package body Exp_Attr is
          begin
             Aux_Decl := Empty;
 
-            --  Generate a nominal type for the constant when the prefix is of
-            --  a constrained type. This is achieved by setting the Etype of
-            --  the relocated prefix to its base type. Since the prefix is now
-            --  the initialization expression of the constant, its freezing
-            --  will produce a proper nominal type.
-
             Temp_Expr := Relocate_Node (Pref);
-            Set_Etype (Temp_Expr, Base_Typ);
+
+            --  For Etype (Temp_Expr) in some cases we cannot use either
+            --  Etype (Pref) or Base_Typ. So we set Etype (Temp_Expr) to null
+            --  and mark Temp_Expr as requiring analysis. Rather than trying
+            --  to sort out exactly when this is needed, we do it
+            --  unconditionally.
+            --  One case where this is needed is when
+            --     1) Pref is an N_Selected_Component name that
+            --        refers to a component which is subject to a
+            --        discriminant-dependent constraint; and
+            --     2) The prefix of that N_Selected_Component refers to a
+            --        formal parameter with an unconstrained subtype; and
+            --     3) Pref has only been preanalyzed (so that
+            --        Build_Actual_Subtype_Of_Component has not been called
+            --        and Etype (Pref) equals the Etype of the component).
+
+            Set_Etype (Temp_Expr, Empty);
+            Set_Analyzed (Temp_Expr, False);
 
             --  Generate:
             --    Temp : constant Base_Typ := Pref;