re PR fortran/54107 ([F03] Memory hog with abstract interface)

[gcc.git] / gcc / fortran / trans-types.c

diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 21aa75c12d35166ab18edbed937811d015225ca1..30561ee7ecfe6465bd3a3269e0dc3ddc15275936 100644 (file)
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2711,19 +2711,23 @@ gfc_get_function_type (gfc_symbol * sym)
   gfc_formal_arglist *f;
   gfc_symbol *arg;
   int alternate_return;
-  bool is_varargs = true;
+  bool is_varargs = true, recursive_type = false;
 
   /* Make sure this symbol is a function, a subroutine or the main
      program.  */
   gcc_assert (sym->attr.flavor == FL_PROCEDURE
              || sym->attr.flavor == FL_PROGRAM);
 
-  if (sym->backend_decl)
-    {
-      if (sym->attr.proc_pointer)
-       return TREE_TYPE (TREE_TYPE (sym->backend_decl));
-      return TREE_TYPE (sym->backend_decl);
-    }
+  /* To avoid recursing infinitely on recursive types, we use error_mark_node
+     so that they can be detected here and handled further down.  */
+  if (sym->backend_decl == NULL)
+    sym->backend_decl = error_mark_node;
+  else if (sym->backend_decl == error_mark_node)
+    recursive_type = true;
+  else if (sym->attr.proc_pointer)
+    return TREE_TYPE (TREE_TYPE (sym->backend_decl));
+  else
+    return TREE_TYPE (sym->backend_decl);
 
   alternate_return = 0;
   typelist = NULL;
@@ -2775,6 +2779,13 @@ gfc_get_function_type (gfc_symbol * sym)
 
          if (arg->attr.flavor == FL_PROCEDURE)
            {
+             /* We don't know in the general case which argument causes
+                recursion.  But we know that it is a procedure.  So we give up
+                creating the procedure argument type list at the first
+                procedure argument.  */
+             if (recursive_type)
+               goto arg_type_list_done;
+
              type = gfc_get_function_type (arg);
              type = build_pointer_type (type);
            }
@@ -2828,6 +2839,11 @@ gfc_get_function_type (gfc_symbol * sym)
       || sym->attr.if_source != IFSRC_UNKNOWN)
     is_varargs = false;
 
+arg_type_list_done:
+
+  if (!recursive_type && sym->backend_decl == error_mark_node)
+    sym->backend_decl = NULL_TREE;
+
   if (alternate_return)
     type = integer_type_node;
   else if (!sym->attr.function || gfc_return_by_reference (sym))
@@ -2865,7 +2881,7 @@ gfc_get_function_type (gfc_symbol * sym)
   else
     type = gfc_sym_type (sym);
 
-  if (is_varargs)
+  if (is_varargs || recursive_type)
     type = build_varargs_function_type_vec (type, typelist);
   else
     type = build_function_type_vec (type, typelist);