decl.c (gnat_to_gnu_entity): In ASIS mode, do a minimal translation for root types...
authorEric Botcazou <ebotcazou@adacore.com>
Tue, 24 Nov 2015 09:00:45 +0000 (09:00 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Tue, 24 Nov 2015 09:00:45 +0000 (09:00 +0000)
* gcc-interface/decl.c (gnat_to_gnu_entity) <Concurrent types>: In
ASIS mode, do a minimal translation for root types with discriminants.
* gcc-interface/trans.c (gnat_to_gnu) <N_Subunit>: Move around.
<N_Entry_Body, N_Protected_Body, N_Task_Body>: Likewise.  In ASIS mode,
process the declarations attached to the body.

From-SVN: r230792

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/trans.c

index e95343be782b136602290313d08368636c0b5297..caea65a6a22109ebd9135be0ccb34ebb72545a40 100644 (file)
@@ -1,3 +1,11 @@
+2015-11-24  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/decl.c (gnat_to_gnu_entity) <Concurrent types>: In
+       ASIS mode, do a minimal translation for root types with discriminants.
+       * gcc-interface/trans.c (gnat_to_gnu) <N_Subunit>: Move around.
+       <N_Entry_Body, N_Protected_Body, N_Task_Body>: Likewise.  In ASIS mode,
+       process the declarations attached to the body.
+
 2015-11-24  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/trans.c (gnat_to_gnu): In type_annotate_only mode, do
index 9994c679a40a66ef9237b9a1c04de78c4bd8ebc8..3ae079ff9047f217ac52955a4fbde522735f0f6b 100644 (file)
@@ -4737,13 +4737,51 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       maybe_present = true;
       break;
 
-    case E_Task_Type:
-    case E_Task_Subtype:
     case E_Protected_Type:
     case E_Protected_Subtype:
-      /* Concurrent types are always transformed into their record type.  */
+    case E_Task_Type:
+    case E_Task_Subtype:
+      /* If we are just annotating types and have no equivalent record type,
+        just return void_type, except for root types that have discriminants
+        because the discriminants will very likely be used in the declarative
+        part of the associated body so they need to be translated.  */
       if (type_annotate_only && No (gnat_equiv_type))
-       gnu_type = void_type_node;
+       {
+         if (Has_Discriminants (gnat_entity)
+             && Root_Type (gnat_entity) == gnat_entity)
+           {
+             tree gnu_field_list = NULL_TREE;
+             Entity_Id gnat_field;
+
+             /* This is a minimal version of the E_Record_Type handling.  */
+             gnu_type = make_node (RECORD_TYPE);
+             TYPE_NAME (gnu_type) = gnu_entity_name;
+
+             for (gnat_field = First_Stored_Discriminant (gnat_entity);
+                  Present (gnat_field);
+                  gnat_field = Next_Stored_Discriminant (gnat_field))
+               {
+                 tree gnu_field
+                   = gnat_to_gnu_field (gnat_field, gnu_type, false,
+                                        definition, debug_info_p);
+
+                 save_gnu_tree (gnat_field,
+                                build3 (COMPONENT_REF, TREE_TYPE (gnu_field),
+                                        build0 (PLACEHOLDER_EXPR, gnu_type),
+                                        gnu_field, NULL_TREE),
+                                true);
+
+                 DECL_CHAIN (gnu_field) = gnu_field_list;
+                 gnu_field_list = gnu_field;
+               }
+
+             TYPE_FIELDS (gnu_type) = nreverse (gnu_field_list);
+           }
+         else
+           gnu_type = void_type_node;
+       }
+
+      /* Concurrent types are always transformed into their record type.  */
       else
        gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, 0);
       maybe_present = true;
index ebb5b5ca2a0d2cbc9edf5b8e36255922a4b47996..fdcf9a3c2203114ef85aeb0cec70a7ded039ea25 100644 (file)
@@ -7272,6 +7272,19 @@ gnat_to_gnu (Node_Id gnat_node)
       gnu_result = alloc_stmt_list ();
       break;
 
+    case N_Subunit:
+      gnu_result = gnat_to_gnu (Proper_Body (gnat_node));
+      break;
+
+    case N_Entry_Body:
+    case N_Protected_Body:
+    case N_Task_Body:
+      /* These nodes should only be present when annotating types.  */
+      gcc_assert (type_annotate_only);
+      process_decls (Declarations (gnat_node), Empty, Empty, true, true);
+      gnu_result = alloc_stmt_list ();
+      break;
+
     case N_Subprogram_Body_Stub:
     case N_Package_Body_Stub:
     case N_Protected_Body_Stub:
@@ -7286,10 +7299,6 @@ gnat_to_gnu (Node_Id gnat_node)
        }
       break;
 
-    case N_Subunit:
-      gnu_result = gnat_to_gnu (Proper_Body (gnat_node));
-      break;
-
     /***************************/
     /* Chapter 11: Exceptions  */
     /***************************/
@@ -7662,8 +7671,6 @@ gnat_to_gnu (Node_Id gnat_node)
     case N_Procedure_Specification:
     case N_Op_Concat:
     case N_Component_Association:
-    case N_Protected_Body:
-    case N_Task_Body:
       /* These nodes should only be present when annotating types.  */
       gcc_assert (type_annotate_only);
       gnu_result = alloc_stmt_list ();