* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Subtype>: Do not
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 19 Jul 2012 15:44:00 +0000 (15:44 +0000)
committerebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Thu, 19 Jul 2012 15:44:00 +0000 (15:44 +0000)
look up the REP part of the base type in advance.  Deal with that of
the variant types.
(get_rep_part): Be prepared for record types with fields.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@189666 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/discr38.adb [new file with mode: 0644]

index 8f3ec64..be2733b 100644 (file)
@@ -1,3 +1,10 @@
+2012-07-19  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Record_Subtype>: Do not
+       look up the REP part of the base type in advance.  Deal with that of
+       the variant types.
+       (get_rep_part): Be prepared for record types with fields.
+
 2012-07-18  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/trans.c (stmt_group_may_fallthru): New function.
index ef7c87c..2aa20e7 100644 (file)
@@ -3287,9 +3287,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              else
                gnu_unpad_base_type = gnu_base_type;
 
-             /* Look for a REP part in the base type.  */
-             gnu_rep_part = get_rep_part (gnu_unpad_base_type);
-
              /* Look for a variant part in the base type.  */
              gnu_variant_part = get_variant_part (gnu_unpad_base_type);
 
@@ -3415,7 +3412,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                       and put the field either in the new type if there is a
                       selected variant or in one of the new variants.  */
                    if (gnu_context == gnu_unpad_base_type
-                       || (gnu_rep_part
+                       || ((gnu_rep_part = get_rep_part (gnu_unpad_base_type))
                            && gnu_context == TREE_TYPE (gnu_rep_part)))
                      gnu_cont_type = gnu_type;
                    else
@@ -3425,7 +3422,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
                        t = NULL_TREE;
                        FOR_EACH_VEC_ELT (variant_desc, gnu_variant_list, i, v)
-                         if (v->type == gnu_context)
+                         if (gnu_context == v->type
+                             || ((gnu_rep_part = get_rep_part (v->type))
+                                 && gnu_context == TREE_TYPE (gnu_rep_part)))
                            {
                              t = v->type;
                              break;
@@ -8172,7 +8171,8 @@ get_rep_part (tree record_type)
 
   /* The REP part is the first field, internal, another record, and its name
      starts with an 'R'.  */
-  if (DECL_INTERNAL_P (field)
+  if (field
+      && DECL_INTERNAL_P (field)
       && TREE_CODE (TREE_TYPE (field)) == RECORD_TYPE
       && IDENTIFIER_POINTER (DECL_NAME (field)) [0] == 'R')
     return field;
index 3283840..e7aac5f 100644 (file)
@@ -1,3 +1,7 @@
+2012-07-19  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/discr38.adb: New test.
+
 2012-07-19  Jakub Jelinek  <jakub@redhat.com>
 
        PR middle-end/54017
diff --git a/gcc/testsuite/gnat.dg/discr38.adb b/gcc/testsuite/gnat.dg/discr38.adb
new file mode 100644 (file)
index 0000000..363d2c6
--- /dev/null
@@ -0,0 +1,40 @@
+-- { dg-do compile }\r
+\r
+procedure Discr38 is\r
+\r
+   type Enum is (OK,\r
+                 NOT_CONNECTED,\r
+                 DISCONNECTED,\r
+                 REQUEST_Q_EMPTY,\r
+                 SERVER_UNAVAILABLE,\r
+                 BUFFER_TOO_SMALL,\r
+                 NO_FREE_SLOT,\r
+                 RAISE_EXCEPTION,\r
+                 REQUEST_CANCELLED,\r
+                 REQUEST_IN_PROGRESS,\r
+                 SERVER_BUSY,\r
+                 BLOCK_ACKNOWLEDGE);\r
+\r
+   type R (Status : Enum := OK) is record\r
+      Status_Block : Integer;\r
+      case Status is\r
+      when RAISE_EXCEPTION =>\r
+         I : Integer;\r
+      when OK =>\r
+         Length : Natural;\r
+         Data   : Integer;\r
+      when others =>\r
+         null;\r
+      end case;\r
+   end record;\r
+   for R use record\r
+      Status        at  0 range 0 .. 7;\r
+      Status_Block  at  4 range 0 .. 31;\r
+      Length        at  8 range 0 .. 31;\r
+   end record;\r
+\r
+   Nil : constant R := (OK, 1, 0, 1);\r
+\r
+begin\r
+   null;\r
+end;\r