From: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon, 9 Feb 2026 11:23:17 +0000 (+0100)
Subject: ada: Adjust translation of non-stored discriminants of tagged subtypes
X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=64ed4d7329498a47f7dc3833708aaed4f24aecfa;p=thirdparty%2Fgcc.git

ada: Adjust translation of non-stored discriminants of tagged subtypes

This changes the translation of non-stored discriminants of tagged subtypes
from the (stored) discriminants of the ultimate ancestor to the (non-stored)
discriminants of the tagged type, for the sake of tagged extensions.

This also contains a code layout tweak to gnat_to_gnu_entity and a minor
improvement to gnat_to_gnu.

gcc/ada/ChangeLog:

	* gcc-interface/decl.cc (gnat_to_gnu_entity) <E_Record_Subtype>: Do
	not repeat conditions in chained tests.
	(copy_and_substitute_in_layout): For a tagged subtype, inherit the
	non-stored dicriminants from the old type explicitely.
	* gcc-interface/trans.cc (gnat_to_gnu): Exclude more contexts for
	the transformation of boolean rvalues.
---

diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index d9b70019c4a..ff7d9bb80b4 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -3727,8 +3727,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 		 we are asked to output GNAT encodings, write a record that
 		 shows what we are a subtype of and also make a variable that
 		 indicates our size, if still variable.  */
-	      if (debug_info_p
-		  && gnat_encodings == DWARF_GNAT_ENCODINGS_ALL)
+	      if (!debug_info_p)
+		;
+
+	      else if (gnat_encodings == DWARF_GNAT_ENCODINGS_ALL)
 		{
 		  tree gnu_subtype_marker = make_node (RECORD_TYPE);
 		  tree gnu_unpad_base_name
@@ -3759,11 +3761,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 					 true, true, NULL, gnat_entity, false);
 		}
 
-	      /* Or else, if the subtype is artificial and GNAT encodings are
-		 not used, use the base record type as the debug type.  */
-	      else if (debug_info_p
-		       && artificial_p
-		       && gnat_encodings != DWARF_GNAT_ENCODINGS_ALL)
+	      /* Or else, if the subtype is artificial, use the base record
+	         type as the debug type.  */
+	      else if (artificial_p)
 		SET_TYPE_DEBUG_TYPE (gnu_type, gnu_unpad_base_type);
 	    }
 
@@ -10975,6 +10975,27 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type,
 	  save_gnu_tree (gnat_field, gnu_field, false);
       }
 
+  /* For a tagged subtype, inherit the non-stored dicriminants from the old
+     type instead of inheriting them from an ancestor.  That's specifically
+     helpful for the Parent_Subtype of tagged extensions when discriminants
+     must be rematerialized by the DWARF back-end, to describe the variant
+     part of extensions, because the discriminants of the old type are also
+     non-stored whereas those of the (ultimate) ancestor are stored.  */
+  if (is_subtype && Is_Tagged_Type (gnat_new_type))
+    for (gnat_field = First_Discriminant (gnat_new_type);
+	 Present (gnat_field);
+	 gnat_field = Next_Discriminant (gnat_field))
+      if (!is_stored_discriminant (gnat_field, gnat_new_type)
+	  && (gnat_old_field = Original_Record_Component (gnat_field))
+	  && Underlying_Type (Scope (gnat_old_field)) == gnat_old_type
+	  && present_gnu_tree (gnat_old_field))
+	{
+	  tree gnu_old_field = get_gnu_tree (gnat_old_field);
+	  if (TREE_CODE (gnu_old_field) == COMPONENT_REF)
+	    gnu_old_field = TREE_OPERAND (gnu_old_field, 1);
+	  save_gnu_tree (gnat_field, gnu_old_field, false);
+	}
+
   /* Put the fields with fixed position in order of increasing position.  */
   if (gnu_field_list)
     gnu_field_list = reverse_sort_field_list (gnu_field_list);
diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
index f66d0b99ba3..5140ed8bbfd 100644
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -8780,6 +8780,8 @@ gnat_to_gnu (Node_Id gnat_node)
 	  || kind == N_Selected_Component)
       && TREE_CODE (get_base_type (gnu_result_type)) == BOOLEAN_TYPE
       && Nkind (Parent (gnat_node)) != N_Attribute_Reference
+      && Nkind (Parent (gnat_node)) != N_Discriminant_Association
+      && Nkind (Parent (gnat_node)) != N_Index_Or_Discriminant_Constraint
       && Nkind (Parent (gnat_node)) != N_Pragma_Argument_Association
       && Nkind (Parent (gnat_node)) != N_Variant_Part
       && !lvalue_required_p (gnat_node, gnu_result_type, false, false))