It's caused by a mode mismatch between variants of the same type.
Tested on x86_64-suse-linux, applied on the mainline and 7 branch.
2017-09-09 Eric Botcazou <ebotca...@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity): Only set theTYPE_ALIGN_OK
and TYPE_BY_REFERENCE_P flags on types after various promotions.
* gcc-interface/trans.c (node_has_volatile_full_access)<N_Identifier>:
Consider all kinds of entities.
2017-09-09 Eric Botcazou <ebotca...@adacore.com>
* gnat.dg/specs/vfa.ads: Rename into...
* gnat.dg/specs/vfa1.ads: ...this.
* gnat.dg/specs/vfa2.ads: New test.
--
Eric BotcazouIndex: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 251906)
+++ gcc-interface/decl.c (working copy)
@@ -4277,18 +4277,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
already defined so we cannot pass true for IN_PLACE here. */
process_attributes (&gnu_type, &attr_list, false, gnat_entity);
- /* Tell the middle-end that objects of tagged types are guaranteed to
- be properly aligned. This is necessary because conversions to the
- class-wide type are translated into conversions to the root type,
- which can be less aligned than some of its derived types. */
- if (Is_Tagged_Type (gnat_entity)
- || Is_Class_Wide_Equivalent_Type (gnat_entity))
- TYPE_ALIGN_OK (gnu_type) = 1;
-
- /* Record whether the type is passed by reference. */
- if (!VOID_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_entity))
- TYPE_BY_REFERENCE_P (gnu_type) = 1;
-
/* ??? Don't set the size for a String_Literal since it is either
confirming or we don't handle it properly (if the low bound is
non-constant). */
@@ -4498,17 +4486,29 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
/* If this is not an unconstrained array type, set some flags. */
if (TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE)
{
+ /* Tell the middle-end that objects of tagged types are guaranteed to
+ be properly aligned. This is necessary because conversions to the
+ class-wide type are translated into conversions to the root type,
+ which can be less aligned than some of its derived types. */
+ if (Is_Tagged_Type (gnat_entity)
+ || Is_Class_Wide_Equivalent_Type (gnat_entity))
+ TYPE_ALIGN_OK (gnu_type) = 1;
+
+ /* Record whether the type is passed by reference. */
+ if (Is_By_Reference_Type (gnat_entity) && !VOID_TYPE_P (gnu_type))
+ TYPE_BY_REFERENCE_P (gnu_type) = 1;
+
+ /* Record whether an alignment clause was specified. */
if (Present (Alignment_Clause (gnat_entity)))
TYPE_USER_ALIGN (gnu_type) = 1;
+ /* Record whether a pragma Universal_Aliasing was specified. */
if (Universal_Aliasing (gnat_entity) && !TYPE_IS_DUMMY_P (gnu_type))
TYPE_UNIVERSAL_ALIASING_P (gnu_type) = 1;
/* If it is passed by reference, force BLKmode to ensure that
objects of this type will always be put in memory. */
- if (TYPE_MODE (gnu_type) != BLKmode
- && AGGREGATE_TYPE_P (gnu_type)
- && TYPE_BY_REFERENCE_P (gnu_type))
+ if (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
SET_TYPE_MODE (gnu_type, BLKmode);
}
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 251906)
+++ gcc-interface/trans.c (working copy)
@@ -4075,8 +4075,6 @@ node_has_volatile_full_access (Node_Id g
case N_Identifier:
case N_Expanded_Name:
gnat_entity = Entity (gnat_node);
- if (Ekind (gnat_entity) != E_Variable)
- break;
return Is_Volatile_Full_Access (gnat_entity)
|| Is_Volatile_Full_Access (Etype (gnat_entity));
-- { dg-do compile }
-- { dg-options "-O" }
package VFA2 is
type Bit is mod 2**1
with Size => 1;
type UInt2 is mod 2**2
with Size => 2;
type UInt22 is mod 2**22
with Size => 22;
type MODE_ENUM is
(
Function_0_Default,
Function_1,
Function_2,
Function_3,
Function_4,
Function_5,
Function_6,
Function_7)
with Size => 3;
type EPD_ENUM is
(
Disable_Pull_Down,
Enable_Pull_Down)
with Size => 1;
type EPUN_ENUM is
(
Enable_Pull_Up,
Disable_Pull_Up)
with Size => 1;
type EHS_ENUM is
(
Slow_Low_Noise_With,
Fast_Medium_Noise_W)
with Size => 1;
type EZI_ENUM is
(
Disable_Input_Buffer,
Enable_Input_Buffer)
with Size => 1;
type ZIF_ENUM is
(
Enable_Input_Glitch,
Disable_Input_Glitch)
with Size => 1;
type EHD_ENUM is
(
Normal_Drive_4_Ma_D,
Medium_Drive_8_Ma_D,
High_Drive_14_Ma_Dr,
Ultra_High_Drive_20)
with Size => 2;
type Pin_Type is (Normal_Drive, High_Drive, High_Speed);
type SFS_Register(Pin : Pin_Type := Normal_Drive) is record
MODE : MODE_ENUM;
EPD : EPD_ENUM;
EPUN : EPUN_ENUM;
EZI : EZI_ENUM;
ZIF : ZIF_ENUM;
RESERVED : UInt22;
case Pin is
when Normal_Drive =>
ND_EHS_RESERVED : Bit;
ND_EHD_RESERVED : UInt2;
when High_Drive =>
EHD : EHD_ENUM;
HD_EHS_RESERVED : Bit;
when High_Speed =>
EHS : EHS_ENUM;
HS_EHD_RESERVED : UInt2;
end case;
end record
with Unchecked_Union, Size => 32, Volatile_Full_Access;
for SFS_Register use record
MODE at 0 range 0 .. 2;
EPD at 0 range 3 .. 3;
EPUN at 0 range 4 .. 4;
ND_EHS_RESERVED at 0 range 5 .. 5;
HD_EHS_RESERVED at 0 range 5 .. 5;
EHS at 0 range 5 .. 5;
EZI at 0 range 6 .. 6;
ZIF at 0 range 7 .. 7;
ND_EHD_RESERVED at 0 range 8 .. 9;
EHD at 0 range 8 .. 9;
HS_EHD_RESERVED at 0 range 8 .. 9;
RESERVED at 0 range 10 .. 31;
end record;
type Normal_Drive_Pins is array (Integer range <>)
of SFS_Register(Normal_Drive) with Volatile;
end VFA2;
