Fix miscompilation of predicate on bit-packed array types

This is a regression present on the mainline and 11 branch in the form of a
miscompilation by the new mod/ref IPA pass of code that passes constrained
bit-packed array objets in a call to a subprograms taking unconstrained
bit-packed array parameters, which occurs for predicate on bit-packed array
types for example.

gcc/ada/
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Add PAT
	local constant and use it throughout.  If it is set, use a ref-all
	pointer type for the pointer-to-array field of the fat pointer type.
	<E_Array_Subtype>: Add PAT local constant and use it throughout.
gcc/testsuite/
	* gnat.dg/bit_packed_array6.adb: New test.
	* gnat.dg/bit_packed_array6_pkg.ads: New helper.

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index bc7046a..6fc94dd 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -2100,6 +2100,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 
     case E_Array_Type:
       {
+       const Entity_Id PAT = Packed_Array_Impl_Type (gnat_entity);
        const bool convention_fortran_p
          = (Convention (gnat_entity) == Convention_Fortran);
        const int ndim = Number_Dimensions (gnat_entity);
@@ -2203,16 +2204,16 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
          }
 
        /* If the GNAT encodings are used, give the fat pointer type a name.
-          If this is a packed array, tell the debugger how to interpret the
-          underlying bits by fetching that of the implementation type.  But
-          in any case, mark it as artificial so the debugger can skip it.  */
+          If this is a packed type implemented specially, tell the debugger
+          how to interpret the underlying bits by fetching the name of the
+          implementation type.  But, in any case, mark it as artificial so
+          the debugger can skip it.  */
        const Entity_Id gnat_name
-         = (Present (Packed_Array_Impl_Type (gnat_entity))
-            && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
-           ? Packed_Array_Impl_Type (gnat_entity)
+         = Present (PAT) && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL
+           ? PAT
            : gnat_entity;
        tree xup_name
-         = (gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL)
+         = gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL
            ? create_concat_name (gnat_name, "XUP")
            : gnu_entity_name;
        create_type_decl (xup_name, gnu_fat_type, true, debug_info_p,
@@ -2347,9 +2348,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 
        /* If this is a packed type implemented specially, then process the
           implementation type so it is elaborated in the proper scope.  */
-       if (Present (Packed_Array_Impl_Type (gnat_entity)))
-         gnat_to_gnu_entity (Packed_Array_Impl_Type (gnat_entity), NULL_TREE,
-                             false);
+       if (Present (PAT))
+         gnat_to_gnu_entity (PAT, NULL_TREE, false);
 
        /* Otherwise, if an alignment is specified, use it if valid and, if
           the alignment was requested with an explicit clause, state so.  */
@@ -2374,8 +2374,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
          tem = change_qualified_type (tem, TYPE_QUAL_VOLATILE);
 
        /* Adjust the type of the pointer-to-array field of the fat pointer
-          and record the aliasing relationships if necessary.  */
-       TREE_TYPE (TYPE_FIELDS (gnu_fat_type)) = build_pointer_type (tem);
+          and record the aliasing relationships if necessary.  If this is
+          a packed type implemented specially, then use a ref-all pointer
+          type since the implementation type may vary between constrained
+          subtypes and unconstrained base type.  */
+       if (Present (PAT))
+         TREE_TYPE (TYPE_FIELDS (gnu_fat_type))
+           = build_pointer_type_for_mode (tem, ptr_mode, true);
+       else
+         TREE_TYPE (TYPE_FIELDS (gnu_fat_type)) = build_pointer_type (tem);
        if (TYPE_ALIAS_SET_KNOWN_P (gnu_fat_type))
          record_component_aliases (gnu_fat_type);
 
@@ -2439,6 +2446,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
        ;
       else
        {
+         const Entity_Id PAT = Packed_Array_Impl_Type (gnat_entity);
          Entity_Id gnat_index, gnat_base_index;
          const bool convention_fortran_p
            = (Convention (gnat_entity) == Convention_Fortran);
@@ -2844,7 +2852,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 
          /* If this is a packed type implemented specially, then replace our
             type with the implementation type.  */
-         if (Present (Packed_Array_Impl_Type (gnat_entity)))
+         if (Present (PAT))
            {
              /* First finish the type we had been making so that we output
                 debugging information for it.  */
@@ -2869,8 +2877,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
                 this type again.  */
              save_gnu_tree (gnat_entity, gnu_tmp_decl, false);
 
-             gnu_type
-               = gnat_to_gnu_type (Packed_Array_Impl_Type (gnat_entity));
+             gnu_type = gnat_to_gnu_type (PAT);
              save_gnu_tree (gnat_entity, NULL_TREE, false);
 
              /* Set the ___XP suffix for GNAT encodings.  */

diff --git a/gcc/testsuite/gnat.dg/bit_packed_array6.adb b/gcc/testsuite/gnat.dg/bit_packed_array6.adb
new file mode 100644 (file)
index 0000000..84f7a4b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bit_packed_array6.adb
@@ -0,0 +1,10 @@
+-- { dg-do run }
+-- { dg-options "-O2 -gnata -gnatVa" }
+
+with Bit_Packed_Array6_Pkg; use Bit_Packed_Array6_Pkg;
+
+procedure Bit_Packed_Array6 is
+  B : constant Boolean := Everywhere (K_Configuration);
+begin
+  null;
+end;

diff --git a/gcc/testsuite/gnat.dg/bit_packed_array6_pkg.ads b/gcc/testsuite/gnat.dg/bit_packed_array6_pkg.ads
new file mode 100644 (file)
index 0000000..4eb1516
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/bit_packed_array6_pkg.ads
@@ -0,0 +1,13 @@
+package Bit_Packed_Array6_Pkg is
+
+   type Project_Kind is
+     (K_Configuration, K_Abstract,
+      K_Standard, K_Library, K_Aggregate, K_Aggregate_Library);
+
+   type Projects_Kind is array (Project_Kind) of Boolean
+     with Pack,
+          Dynamic_Predicate => Projects_Kind /= (Project_Kind => False);
+
+   Everywhere : constant Projects_Kind := (others => True);
+
+end Bit_Packed_Array6_Pkg;