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.
Tested on x86-64/Linux, applied on the mainline.
2021-06-03 Eric Botcazou <ebotca...@adacore.com>
* 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.
2021-06-03 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/bit_packed_array6.adb: New test.
* gnat.dg/bit_packed_array6_pkg.ads: New helper.
--
Eric Botcazoudiff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index bc7046accb5..6fc94dda83b 100644
--- 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. */
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;
-- { 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;
