]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/58007 ([OOP] ICE in free_pi_tree(): Unresolved fixup - resolve_fixups...
authorMikael Morin <mikael@gcc.gnu.org>
Sat, 18 Jan 2014 20:05:25 +0000 (20:05 +0000)
committerMikael Morin <mikael@gcc.gnu.org>
Sat, 18 Jan 2014 20:05:25 +0000 (20:05 +0000)
fortran/
        PR fortran/58007
        * module.c (MOD_VERSION): Bump.
        (fp2, find_pointer2): Remove.
        (mio_component_ref): Don't forcedfully set the containing derived type
        symbol for loading.  Remove unused argument.
        (mio_ref): Update caller
        (mio_symbol): Dump component list earlier.
        (skip_list): New argument nest_level.  Initialize level with the new
        argument.
        (read_module): Add forced pointer components association for derived
        type symbols.

testsuite/
        PR fortran/58007
        * gfortran.dg/unresolved_fixup_1.f90: New test.
        * gfortran.dg/unresolved_fixup_2.f90: New test.

From-SVN: r206759

gcc/fortran/ChangeLog
gcc/fortran/module.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 [new file with mode: 0644]

index f2f1a853ddfcc90c6c8af84266f2da476db7f440..802ca7321481010f2140bf60464dbd00bc609252 100644 (file)
@@ -1,3 +1,17 @@
+2014-01-18  Mikael Morin  <mikael@gcc.gnu.org>
+
+       PR fortran/58007
+       * module.c (MOD_VERSION): Bump.
+       (fp2, find_pointer2): Remove.
+       (mio_component_ref): Don't forcedfully set the containing derived type
+       symbol for loading.  Remove unused argument.
+       (mio_ref): Update caller
+       (mio_symbol): Dump component list earlier.
+       (skip_list): New argument nest_level.  Initialize level with the new
+       argument.
+       (read_module): Add forced pointer components association for derived
+       type symbols.
+
 2014-01-12  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/58026
index cad835fae372974cfe373317c0c1d7dee66d226c..90fe7b9484177b5f06de4958af44ad096315ca05 100644 (file)
@@ -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:
@@ -3855,7 +3792,9 @@ mio_full_f2k_derived (gfc_symbol *sym)
 
 
 /* Unlike most other routines, the address of the symbol node is already
-   fixed on input and the name/module has already been filled in.  */
+   fixed on input and the name/module has already been filled in.
+   If you update the symbol format here, don't forget to update read_module
+   as well (look for "seek to the symbol's component list").   */
 
 static void
 mio_symbol (gfc_symbol *sym)
@@ -3865,6 +3804,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 +3840,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);
 
@@ -3997,14 +3935,17 @@ find_symbol (gfc_symtree *st, const char *name,
 }
 
 
-/* Skip a list between balanced left and right parens.  */
+/* Skip a list between balanced left and right parens.
+   By setting NEST_LEVEL one assumes that a number of NEST_LEVEL opening parens
+   have been already parsed by hand, and the remaining of the content is to be
+   skipped here.  The default value is 0 (balanced 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 +4579,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 +4589,45 @@ 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;
+
+         /* First seek to the symbol's component list.  */
+         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
index f57666977647c91eeaa692e55ed5d6ff89571f83..48b309025b7e3cec537d037a6b19071b5d9edceb 100644 (file)
@@ -1,3 +1,9 @@
+2014-01-18  Mikael Morin  <mikael@gcc.gnu.org>
+
+       PR fortran/58007
+       * gfortran.dg/unresolved_fixup_1.f90: New test.
+       * gfortran.dg/unresolved_fixup_2.f90: New test.
+
 2014-01-18  Jakub Jelinek  <jakub@redhat.com>
 
        PR target/58944
@@ -19,7 +25,7 @@
 
 2014-01-17  Jeff Law  <law@redhat.com>
 
-        PR middle-end/57904
+       PR middle-end/57904
        * gfortran.dg/pr57904.f90: New test.
 
 2014-01-17  Paolo Carlini  <paolo.carlini@oracle.com>
diff --git a/gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90 b/gcc/testsuite/gfortran.dg/unresolved_fixup_1.f90
new file mode 100644 (file)
index 0000000..07fbce3
--- /dev/null
@@ -0,0 +1,44 @@
+! { 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 Daniel Shapiro <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
diff --git a/gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90 b/gcc/testsuite/gfortran.dg/unresolved_fixup_2.f90
new file mode 100644 (file)
index 0000000..ca0a05a
--- /dev/null
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! PR fortran/58007
+! Unresolved fiixup 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 Daniel Shapiro <shapero@uw.edu>
+
+module matrix
+  type :: sparse_matrix
+    integer :: max_degree
+  end type
+end module
+
+module bsr
+  use matrix
+
+  type, extends(sparse_matrix) :: bsr_matrix
+  end type
+
+  integer :: i1
+  integer :: i2
+  integer :: i3
+contains
+  function get_neighbors (A)
+    type(bsr_matrix), intent(in) :: A
+    integer :: get_neighbors(A%max_degree)
+  end function
+end module
+
+program main
+  use matrix
+  use bsr
+end