diff mbox series

[COMMITTED,47/51] ada: Plug loophole in layout derivation machinery

Message ID 20260602084541.3829876-47-poulhies@adacore.com
State Committed
Headers
Series [COMMITTED,01/51] ada: Rename Private_Component function |

Commit Message

Marc Poulhiès June 2, 2026, 8:45 a.m. UTC 
  From: Eric Botcazou <ebotcazou@adacore.com>

The machinery that computes the layout of derived types does not deal with
the variant part of unchecked union types that also contain a fixed part,
because this variant part is represented by a (mere) union type instead of
a qualified union type.

gcc/ada/ChangeLog:

	* gcc-interface/decl.cc (components_to_record): Tweak comment.
	(build_position_list): Deal with unchecked union types.
	(build_variant_list): Likewise.
	(get_variant_part): Likewise.
	(create_variant_part_from): Likewise.
	(copy_and_substitute_in_layout): Likewise.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/gcc-interface/decl.cc | 24 +++++++++++++-----------
 1 file changed, 13 insertions(+), 11 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index ff7d9bb80b4..9b64544a2f2 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -8617,9 +8617,9 @@  components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type,
      mutually exclusive and should go in the same memory.  To do this we need
      to treat each variant as a record whose elements are created from the
      component list for the variant.  So here we create the records from the
-     lists for the variants and put them all into the QUAL_UNION_TYPE.
-     If this is an Unchecked_Union, we make a UNION_TYPE instead or
-     use GNU_RECORD_TYPE if there are no fields so far.  */
+     lists for the variants and put them all into the QUAL_UNION_TYPE.  But
+     if this is an Unchecked_Union, we make a UNION_TYPE instead, or reuse
+     GNU_RECORD_TYPE (which is a UNION_TYPE) if there are no fixed fields.  */
   if (Present (gnat_variant_part))
     {
       Node_Id gnat_discr = Name (gnat_variant_part), variant;
@@ -9724,7 +9724,8 @@  build_position_list (tree gnu_type, bool do_not_flatten_variant, tree gnu_pos,
 	{
 	  tree gnu_field_type = TREE_TYPE (gnu_field);
 	  if (do_not_flatten_variant
-	      && TREE_CODE (gnu_field_type) == QUAL_UNION_TYPE)
+	      && (TREE_CODE (gnu_field_type) == QUAL_UNION_TYPE
+		  || TREE_CODE (gnu_field_type) == UNION_TYPE))
 	    gnu_list
 	      = build_position_list (gnu_field_type, do_not_flatten_variant,
 				     size_zero_node, bitsize_zero_node,
@@ -9811,7 +9812,7 @@  build_variant_list (tree gnu_qual_union_type, Node_Id gnat_variant_part,
 
       /* If the new qualifier is not unconditionally false, its variant may
 	 still be accessed.  */
-      if (!integer_zerop (qual))
+      if (!qual || !integer_zerop (qual))
 	{
 	  tree variant_type = TREE_TYPE (gnu_field), variant_subpart;
 	  variant_desc v
@@ -9820,7 +9821,7 @@  build_variant_list (tree gnu_qual_union_type, Node_Id gnat_variant_part,
 	  gnu_list.safe_push (v);
 
 	  /* Annotate the GNAT node if present.  */
-	  if (Present (gnat_variant))
+	  if (qual && Present (gnat_variant))
 	    Set_Present_Expr (gnat_variant, annotate_value (qual));
 
 	  /* Recurse on the variant subpart of the variant, if any.  */
@@ -9837,7 +9838,7 @@  build_variant_list (tree gnu_qual_union_type, Node_Id gnat_variant_part,
 
 	  /* If the new qualifier is unconditionally true, the subsequent
 	     variants cannot be accessed.  */
-	  if (integer_onep (qual))
+	  if (qual && integer_onep (qual))
 	    break;
 	}
     }
@@ -10552,10 +10553,11 @@  get_variant_part (tree record_type)
 {
   tree field;
 
-  /* The variant part is the only internal field that is a qualified union.  */
+  /* The variant part is the only internal field that is a union.  */
   for (field = TYPE_FIELDS (record_type); field; field = DECL_CHAIN (field))
     if (DECL_INTERNAL_P (field)
-	&& TREE_CODE (TREE_TYPE (field)) == QUAL_UNION_TYPE)
+	&& (TREE_CODE (TREE_TYPE (field)) == QUAL_UNION_TYPE
+	    || TREE_CODE (TREE_TYPE (field)) == UNION_TYPE))
       return field;
 
   return NULL_TREE;
@@ -10582,7 +10584,7 @@  create_variant_part_from (tree old_variant_part,
   unsigned int i;
 
   /* First create the type of the variant part from that of the old one.  */
-  new_union_type = make_node (QUAL_UNION_TYPE);
+  new_union_type = make_node (TREE_CODE (TREE_TYPE (old_variant_part)));
   TYPE_NAME (new_union_type)
     = concat_name (TYPE_NAME (record_type),
 		   IDENTIFIER_POINTER (DECL_NAME (old_variant_part)));
@@ -10785,7 +10787,7 @@  copy_and_substitute_in_layout (Entity_Id gnat_new_type,
 	 is statically selected.  */
       selected_variant = true;
       FOR_EACH_VEC_ELT (gnu_variant_list, i, v)
-	if (!integer_onep (v->qual))
+	if (!v->qual || !integer_onep (v->qual))
 	  {
 	    selected_variant = false;
 	    break;