decl.c (gnat_to_gnu_entity): Only set the TYPE_ALIGN_OK and TYPE_BY_REFERENCE_P flags...
authorEric Botcazou <ebotcazou@adacore.com>
Sat, 9 Sep 2017 12:02:57 +0000 (12:02 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Sat, 9 Sep 2017 12:02:57 +0000 (12:02 +0000)
* 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

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/trans.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/specs/vfa.ads [deleted file]
gcc/testsuite/gnat.dg/specs/vfa1.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/specs/vfa2.ads [new file with mode: 0644]

index 65b683349294c3aa1aba3e57d247c732fd85ff14..6015967ab325349a1744e79edef814d108dc7dd4 100644 (file)
@@ -1,3 +1,10 @@
+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,
index baa925999fa4b0839e1812fd35ec80cc228ac5dc..df88ce7849e658305f9579e38bcc277746ffbace 100644 (file)
@@ -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.  */
       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_entity, tree gnu_expr, bool definition)
       /* 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 8eff9c3c0980a89d82ac68b1877f22b8f763c4aa..2f7d497b11be1b87124ebed3d9e275df9ff2decf 100644 (file)
@@ -4075,8 +4075,6 @@ node_has_volatile_full_access (Node_Id gnat_node)
     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));
 
index cdbb5557011becb88014e1ee5f18c508b86f666f..928a1e42006bc2ce02a0cbd2e383c12d967a01db 100644 (file)
@@ -1,3 +1,9 @@
+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>
 
        * gfortran.dg/pdt_1.f03 : New test.
diff --git a/gcc/testsuite/gnat.dg/specs/vfa.ads b/gcc/testsuite/gnat.dg/specs/vfa.ads
deleted file mode 100644 (file)
index a63be96..0000000
+++ /dev/null
@@ -1,14 +0,0 @@
--- { dg-do compile }
--- { dg-options "-g" }
-
-package VFA is
-
-  type Rec is record
-    A : Short_Integer;
-    B : Short_Integer;
-  end record;
-
-  type Rec_VFA is new Rec;
-  pragma Volatile_Full_Access (Rec_VFA);
-
-end VFA;
diff --git a/gcc/testsuite/gnat.dg/specs/vfa1.ads b/gcc/testsuite/gnat.dg/specs/vfa1.ads
new file mode 100644 (file)
index 0000000..cf918c2
--- /dev/null
@@ -0,0 +1,14 @@
+-- { dg-do compile }
+-- { dg-options "-g" }
+
+package VFA1 is
+
+  type Rec is record
+    A : Short_Integer;
+    B : Short_Integer;
+  end record;
+
+  type Rec_VFA is new Rec;
+  pragma Volatile_Full_Access (Rec_VFA);
+
+end VFA1;
diff --git a/gcc/testsuite/gnat.dg/specs/vfa2.ads b/gcc/testsuite/gnat.dg/specs/vfa2.ads
new file mode 100644 (file)
index 0000000..8ca9687
--- /dev/null
@@ -0,0 +1,110 @@
+-- { 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;