[Patch, fortran] PR58007: unresolved fixup hell

[Mikael Morin <mikael dot morin at sfr dot fr>]

Hello,

this patch fixes PR58007, where the compiler was not able to relate a
component pointer to any loaded derived type symbol.
The problem came from an optimization avoiding loading again a symbol
which had already been loaded, skipping by the way the association of
component pointers (if the symbol was a derived type) with the
corresponding module indexes.

The attached patch fixes this by reading the derived type symbol dump's
component list and do the pointer<->integer association by hand.  Then
the regular on demand module loading code works properly and some code
in mio_component_ref that was forcing the module loading of the
containing derived type can be removed.
To associate the component pointers with the module integers, one has to
parse the symbol, or at least its components.  It is done by hand in
this patch and to reduce the maintainance burden (for possible future
evolutions of symbol dumping format/content) the component list is moved
at the beginning.  More exactly just after the symbol attributes,
because the check_for_ambiguous function relies on the symbol attributes
appearing first in a symbol.
This changes the module format, so MOD_VERSION is  bumped.

Regression tested on x86_64-unknown-linux-gnu. OK for trunk?
I plan to submit a variant that doesn't change the module format for the
branches (doing more parsing by hand).

Mikael

Attachment: pr58007_v2.CL
Description: Text document

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 98e22df..20bf1ba 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -82,7 +82,7 @@ along with GCC; see the file COPYING3.  If not see
 
 /* Don't put any single quote (') in MOD_VERSION, if you want it to be
    recognized.  */
-#define MOD_VERSION "11"
+#define MOD_VERSION "12"
 
 
 /* Structure that describes a position within a module file.  */
@@ -390,37 +390,6 @@ get_integer (int integer)
 }
 
 
-/* Recursive function to find a pointer within a tree by brute force.  */
-
-static pointer_info *
-fp2 (pointer_info *p, const void *target)
-{
-  pointer_info *q;
-
-  if (p == NULL)
-    return NULL;
-
-  if (p->u.pointer == target)
-    return p;
-
-  q = fp2 (p->left, target);
-  if (q != NULL)
-    return q;
-
-  return fp2 (p->right, target);
-}
-
-
-/* During reading, find a pointer_info node from the pointer value.
-   This amounts to a brute-force search.  */
-
-static pointer_info *
-find_pointer2 (void *p)
-{
-  return fp2 (pi_root, p);
-}
-
-
 /* Resolve any fixups using a known pointer.  */
 
 static void
@@ -2588,45 +2557,13 @@ mio_pointer_ref (void *gp)
    the namespace and is not loaded again.  */
 
 static void
-mio_component_ref (gfc_component **cp, gfc_symbol *sym)
+mio_component_ref (gfc_component **cp)
 {
-  char name[GFC_MAX_SYMBOL_LEN + 1];
-  gfc_component *q;
   pointer_info *p;
 
   p = mio_pointer_ref (cp);
   if (p->type == P_UNKNOWN)
     p->type = P_COMPONENT;
-
-  if (iomode == IO_OUTPUT)
-    mio_pool_string (&(*cp)->name);
-  else
-    {
-      mio_internal_string (name);
-
-      if (sym && sym->attr.is_class)
-	sym = sym->components->ts.u.derived;
-
-      /* It can happen that a component reference can be read before the
-	 associated derived type symbol has been loaded. Return now and
-	 wait for a later iteration of load_needed.  */
-      if (sym == NULL)
-	return;
-
-      if (sym->components != NULL && p->u.pointer == NULL)
-	{
-	  /* Symbol already loaded, so search by name.  */
-	  q = gfc_find_component (sym, name, true, true);
-
-	  if (q)
-	    associate_integer_pointer (p, q);
-	}
-
-      /* Make sure this symbol will eventually be loaded.  */
-      p = find_pointer2 (sym);
-      if (p->u.rsym.state == UNUSED)
-	p->u.rsym.state = NEEDED;
-    }
 }
 
 
@@ -2983,7 +2920,7 @@ mio_ref (gfc_ref **rp)
 
     case REF_COMPONENT:
       mio_symbol_ref (&r->u.c.sym);
-      mio_component_ref (&r->u.c.component, r->u.c.sym);
+      mio_component_ref (&r->u.c.component);
       break;
 
     case REF_SUBSTRING:
@@ -3865,6 +3802,14 @@ mio_symbol (gfc_symbol *sym)
   mio_lparen ();
 
   mio_symbol_attribute (&sym->attr);
+
+  /* Note that components are always saved, even if they are supposed
+     to be private.  Component access is checked during searching.  */
+  mio_component_list (&sym->components, sym->attr.vtype);
+  if (sym->components != NULL)
+    sym->component_access
+      = MIO_NAME (gfc_access) (sym->component_access, access_types);
+
   mio_typespec (&sym->ts);
   if (sym->ts.type == BT_CLASS)
     sym->attr.class_ok = 1;
@@ -3893,15 +3838,6 @@ mio_symbol (gfc_symbol *sym)
   if (sym->attr.cray_pointee)
     mio_symbol_ref (&sym->cp_pointer);
 
-  /* Note that components are always saved, even if they are supposed
-     to be private.  Component access is checked during searching.  */
-
-  mio_component_list (&sym->components, sym->attr.vtype);
-
-  if (sym->components != NULL)
-    sym->component_access
-      = MIO_NAME (gfc_access) (sym->component_access, access_types);
-
   /* Load/save the f2k_derived namespace of a derived-type symbol.  */
   mio_full_f2k_derived (sym);
 
@@ -4000,11 +3936,11 @@ find_symbol (gfc_symtree *st, const char *name,
 /* Skip a list between balanced left and right parens.  */
 
 static void
-skip_list (void)
+skip_list (int nest_level = 0)
 {
   int level;
 
-  level = 0;
+  level = nest_level;
   do
     {
       switch (parse_atom ())
@@ -4638,7 +4574,6 @@ read_module (void)
       info->u.rsym.ns = atom_int;
 
       get_module_locus (&info->u.rsym.where);
-      skip_list ();
 
       /* See if the symbol has already been loaded by a previous module.
 	 If so, we reference the existing symbol and prevent it from
@@ -4649,10 +4584,44 @@ read_module (void)
 
       if (sym == NULL
 	  || (sym->attr.flavor == FL_VARIABLE && info->u.rsym.ns !=1))
-	continue;
+	{
+	  skip_list ();
+	  continue;
+	}
 
       info->u.rsym.state = USED;
       info->u.rsym.sym = sym;
+      /* The current symbol has already been loaded, so we can avoid loading
+	 it again.  However, if it is a derived type, some of its components
+	 can be used in expressions in the module.  To avoid the module loading
+	 failing, we need to associate the module's component pointer indexes
+	 with the existing symbol's component pointers.  */
+      if (sym->attr.flavor == FL_DERIVED)
+	{
+	  gfc_component *c;
+
+	  mio_lparen (); /* symbol opening.  */
+	  skip_list (); /* skip symbol attribute.  */
+
+	  mio_lparen (); /* component list opening.  */
+	  for (c = sym->components; c; c = c->next)
+	    {
+	      pointer_info *p;
+	      int n;
+
+	      mio_lparen (); /* component opening.  */
+	      mio_integer (&n);
+	      p = get_integer (n);
+	      if (p->u.pointer == NULL)
+		associate_integer_pointer (p, c);
+	      skip_list (1); /* component end.  */
+	    }
+	  mio_rparen (); /* component list closing.  */
+
+	  skip_list (1); /* symbol end.  */
+	}
+      else
+	skip_list ();
 
       /* Some symbols do not have a namespace (eg. formal arguments),
 	 so the automatic "unique symtree" mechanism must be suppressed





! { dg-do compile }
!
! PR fortran/58007
! Unresolved fixup while loading a module.
!
! This tests that the specification expression A%MAX_DEGREE in module BSR is
! correctly loaded and resolved in program MAIN.
!
! Original testcase from shapero <shapero@uw.edu>
! Reduced by Tobias Burnus <burnus@net-b.de> and Janus Weil <janus@gcc.gnu.org>

module matrix
  type :: sparse_matrix
    integer :: max_degree
  end type
contains
  subroutine init_interface (A)
    class(sparse_matrix), intent(in) :: A
  end subroutine
  real function get_value_interface()
  end function
end module

module ellpack
  use matrix
end module

module bsr
  use matrix
  type, extends(sparse_matrix) :: bsr_matrix
  contains
    procedure :: get_neighbors
  end type
contains
  function get_neighbors (A)
    class(bsr_matrix), intent(in) :: A
    integer :: get_neighbors(A%max_degree)
  end function
end module

program main
  use ellpack
  use bsr
end