* trans-decl.c (gfc_build_qualified_array): Don't skip generation

of range types.
* trans.h (struct lang_type): Add base_decls.
(GFC_TYPE_ARRAY_BASE_DECL): New.
* trans-types.c (gfc_get_array_type_bounds): Initialize base decls
proactively and excessively.
(gfc_get_array_descr_info): Use existing base decls if available.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c93aa12..eda5dfe 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2009-06-05  Alexandre Oliva  <aoliva@redhat.com>
+
+       * trans-decl.c (gfc_build_qualified_array): Don't skip generation
+       of range types.
+       * trans.h (struct lang_type): Add base_decls.
+       (GFC_TYPE_ARRAY_BASE_DECL): New.
+       * trans-types.c (gfc_get_array_type_bounds): Initialize base decls
+       proactively and excessively.
+       (gfc_get_array_descr_info): Use existing base decls if available.
+
 2009-06-04  Daniel Franke  <franke.daniel@gmail.com>
 
        PR fortran/37203

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index ef6172c..cbfff29 100644 (file)
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -713,9 +713,6 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
       layout_type (type);
     }
 
-  if (write_symbols == NO_DEBUG)
-    return;
-
   if (TYPE_NAME (type) != NULL_TREE
       && GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1) != NULL_TREE
       && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1)) == VAR_DECL)

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 2e6889b..0b4be58 100644 (file)
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1675,6 +1675,16 @@ gfc_get_array_type_bounds (tree etype, int dimen, tree * lbound,
   arraytype = build_pointer_type (arraytype);
   GFC_TYPE_ARRAY_DATAPTR_TYPE (fat_type) = arraytype;
 
+  /* This will generate the base declarations we need to emit debug
+     information for this type.  FIXME: there must be a better way to
+     avoid divergence between compilations with and without debug
+     information.  */
+  {
+    struct array_descr_info info;
+    gfc_get_array_descr_info (fat_type, &info);
+    gfc_get_array_descr_info (build_pointer_type (fat_type), &info);
+  }
+
   return fat_type;
 }
 \f
@@ -2398,14 +2408,16 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info)
   info->ndimensions = rank;
   info->element_type = etype;
   ptype = build_pointer_type (gfc_array_index_type);
-  if (indirect)
+  base_decl = GFC_TYPE_ARRAY_BASE_DECL (type, indirect);
+  if (!base_decl)
     {
-      info->base_decl = build_decl (VAR_DECL, NULL_TREE,
-                                   build_pointer_type (ptype));
-      base_decl = build1 (INDIRECT_REF, ptype, info->base_decl);
+      base_decl = build_decl (VAR_DECL, NULL_TREE,
+                             indirect ? build_pointer_type (ptype) : ptype);
+      GFC_TYPE_ARRAY_BASE_DECL (type, indirect) = base_decl;
     }
-  else
-    info->base_decl = base_decl = build_decl (VAR_DECL, NULL_TREE, ptype);
+  info->base_decl = base_decl;
+  if (indirect)
+    base_decl = build1 (INDIRECT_REF, ptype, base_decl);
 
   if (GFC_TYPE_ARRAY_SPAN (type))
     elem_size = GFC_TYPE_ARRAY_SPAN (type);

diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 9068969..5152b95 100644 (file)
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -624,6 +624,7 @@ struct GTY(())      lang_type        {
   tree dtype;
   tree dataptr_type;
   tree span;
+  tree base_decl[2];
 };
 
 struct GTY(()) lang_decl {
@@ -676,6 +677,8 @@ struct GTY(()) lang_decl {
 #define GFC_TYPE_ARRAY_DATAPTR_TYPE(node) \
   (TYPE_LANG_SPECIFIC(node)->dataptr_type)
 #define GFC_TYPE_ARRAY_SPAN(node) (TYPE_LANG_SPECIFIC(node)->span)
+#define GFC_TYPE_ARRAY_BASE_DECL(node, internal) \
+  (TYPE_LANG_SPECIFIC(node)->base_decl[(internal)])
 
 /* Build an expression with void type.  */
 #define build1_v(code, arg) fold_build1(code, void_type_node, arg)