Commit ea09ecc5 by Eric Botcazou Committed by Eric Botcazou

decl.c (gnat_to_gnu_entity): Only set the TYPE_ALIGN_OK and TYPE_BY_REFERENCE_P…

decl.c (gnat_to_gnu_entity): Only set the TYPE_ALIGN_OK and TYPE_BY_REFERENCE_P flags on types after various...

	* gcc-interface/decl.c (gnat_to_gnu_entity): Only set the TYPE_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.

From-SVN: r251927
parent 5bab4c96
2017-09-09 Eric Botcazou <ebotcazou@adacore.com> 2017-09-09 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity): Only set the TYPE_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 <ebotcazou@adacore.com>
* gcc-interface/utils.c (convert): When converting to a padding type, * gcc-interface/utils.c (convert): When converting to a padding type,
reuse an existing CONSTRUCTOR if it has got the right size. reuse an existing CONSTRUCTOR if it has got the right size.
......
...@@ -4277,18 +4277,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -4277,18 +4277,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
already defined so we cannot pass true for IN_PLACE here. */ already defined so we cannot pass true for IN_PLACE here. */
process_attributes (&gnu_type, &attr_list, false, gnat_entity); 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 /* ??? 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 confirming or we don't handle it properly (if the low bound is
non-constant). */ non-constant). */
...@@ -4498,17 +4486,29 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition) ...@@ -4498,17 +4486,29 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
/* If this is not an unconstrained array type, set some flags. */ /* If this is not an unconstrained array type, set some flags. */
if (TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE) 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))) if (Present (Alignment_Clause (gnat_entity)))
TYPE_USER_ALIGN (gnu_type) = 1; 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)) if (Universal_Aliasing (gnat_entity) && !TYPE_IS_DUMMY_P (gnu_type))
TYPE_UNIVERSAL_ALIASING_P (gnu_type) = 1; TYPE_UNIVERSAL_ALIASING_P (gnu_type) = 1;
/* If it is passed by reference, force BLKmode to ensure that /* If it is passed by reference, force BLKmode to ensure that
objects of this type will always be put in memory. */ objects of this type will always be put in memory. */
if (TYPE_MODE (gnu_type) != BLKmode if (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type))
&& AGGREGATE_TYPE_P (gnu_type)
&& TYPE_BY_REFERENCE_P (gnu_type))
SET_TYPE_MODE (gnu_type, BLKmode); SET_TYPE_MODE (gnu_type, BLKmode);
} }
......
...@@ -4075,8 +4075,6 @@ node_has_volatile_full_access (Node_Id gnat_node) ...@@ -4075,8 +4075,6 @@ node_has_volatile_full_access (Node_Id gnat_node)
case N_Identifier: case N_Identifier:
case N_Expanded_Name: case N_Expanded_Name:
gnat_entity = Entity (gnat_node); gnat_entity = Entity (gnat_node);
if (Ekind (gnat_entity) != E_Variable)
break;
return Is_Volatile_Full_Access (gnat_entity) return Is_Volatile_Full_Access (gnat_entity)
|| Is_Volatile_Full_Access (Etype (gnat_entity)); || Is_Volatile_Full_Access (Etype (gnat_entity));
......
2017-09-09 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/specs/vfa.ads: Rename into...
* gnat.dg/specs/vfa1.ads: ...this.
* gnat.dg/specs/vfa2.ads: New test.
2017-09-09 Paul Thomas <pault@gcc.gnu.org> 2017-09-09 Paul Thomas <pault@gcc.gnu.org>
* gfortran.dg/pdt_1.f03 : New test. * gfortran.dg/pdt_1.f03 : New test.
......
-- { dg-do compile } -- { dg-do compile }
-- { dg-options "-g" } -- { dg-options "-g" }
package VFA is package VFA1 is
type Rec is record type Rec is record
A : Short_Integer; A : Short_Integer;
...@@ -11,4 +11,4 @@ package VFA is ...@@ -11,4 +11,4 @@ package VFA is
type Rec_VFA is new Rec; type Rec_VFA is new Rec;
pragma Volatile_Full_Access (Rec_VFA); pragma Volatile_Full_Access (Rec_VFA);
end VFA; end VFA1;
-- { 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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment