Re: [Patch, fortran] PR36366 - [4.3/4.4 Regression] ICE in gfc_conv_component_ref

["Paul Richard Thomas" <paul dot richard dot thomas at gmail dot com>]

Ooops - I'm getting rusty:) The attached patch includes the testcase.

Paul

On Mon, Jun 16, 2008 at 11:01 PM, Paul Richard Thomas
<paul.richard.thomas@gmail.com> wrote:
> This patch is self-explanatory and the testcase is the reporter's.
>
> Bootstrapped and regtested on x86_ia64/FC8 - OK for trunk and 4.3?
>
> Paul
>
> 2008-06-16  Paul Thomas  <pault@gcc.gnu.org>
>
>        PR fortran/34396
>        * resolve.c (add_dt_to_dt_list):  New function.
>        (resolve_fl_derived): Call new function for pointer components
>        and when derived type is resolved.
>
> 2008-06-16  Paul Thomas  <pault@gcc.gnu.org>
>
>        PR fortran/36366
>        * gfortran.dg/used_types_20.f90: New test.
>

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 136811)
--- gcc/fortran/resolve.c	(working copy)
*************** error:
*** 7586,7598 ****
  }
  
  
  /* Resolve the components of a derived type.  */
  
  static try
  resolve_fl_derived (gfc_symbol *sym)
  {
    gfc_component *c;
-   gfc_dt_list * dt_list;
    int i;
  
    for (c = sym->components; c != NULL; c = c->next)
--- 7586,7618 ----
  }
  
  
+ /* Add a derived type to the dt_list.  The dt_list is used in trans-types.c
+    to give all identical derived types the same backend_decl.  */
+ static void
+ add_dt_to_dt_list (gfc_symbol *derived)
+ {
+   gfc_dt_list *dt_list;
+ 
+   for (dt_list = gfc_derived_types; dt_list; dt_list = dt_list->next)
+     if (derived == dt_list->derived)
+       break;
+ 
+   if (dt_list == NULL)
+     {
+       dt_list = gfc_get_dt_list ();
+       dt_list->next = gfc_derived_types;
+       dt_list->derived = derived;
+       gfc_derived_types = dt_list;
+     }
+ }
+ 
+ 
  /* Resolve the components of a derived type.  */
  
  static try
  resolve_fl_derived (gfc_symbol *sym)
  {
    gfc_component *c;
    int i;
  
    for (c = sym->components; c != NULL; c = c->next)
*************** resolve_fl_derived (gfc_symbol *sym)
*** 7644,7649 ****
--- 7664,7679 ----
  	  return FAILURE;
  	}
  
+       /* Ensure that all the derived type components are put on the
+ 	 derived type list; even in formal namespaces, where derived type
+ 	 pointer components might not have been declared.  */
+       if (c->ts.type == BT_DERIVED
+ 	    && c->ts.derived
+ 	    && c->ts.derived->components
+ 	    && c->pointer
+ 	    && sym != c->ts.derived)
+ 	add_dt_to_dt_list (c->ts.derived);
+ 
        if (c->pointer || c->allocatable ||  c->as == NULL)
  	continue;
  
*************** resolve_fl_derived (gfc_symbol *sym)
*** 7669,7685 ****
      return FAILURE;
  
    /* Add derived type to the derived type list.  */
!   for (dt_list = gfc_derived_types; dt_list; dt_list = dt_list->next)
!     if (sym == dt_list->derived)
!       break;
! 
!   if (dt_list == NULL)
!     {
!       dt_list = gfc_get_dt_list ();
!       dt_list->next = gfc_derived_types;
!       dt_list->derived = sym;
!       gfc_derived_types = dt_list;
!     }
  
    return SUCCESS;
  }
--- 7699,7705 ----
      return FAILURE;
  
    /* Add derived type to the derived type list.  */
!   add_dt_to_dt_list (sym);
  
    return SUCCESS;
  }
Index: gcc/testsuite/gfortran.dg/used_types_20.f90
===================================================================
*** gcc/testsuite/gfortran.dg/used_types_20.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/used_types_20.f90	(revision 0)
***************
*** 0 ****
--- 1,49 ----
+ ! { dg-do compile }
+ ! Tests the fix for PR36366 a regression in which the order of USE statements
+ ! in 'test2' would cause the result of 'test1' not to have a reference to
+ ! the derived type 'inner'.
+ !
+ ! Contributed by Jakub Jelinek <jakub@gcc.gnu.org>
+ !
+ MODULE types
+   IMPLICIT NONE
+   TYPE :: inner
+     INTEGER, POINTER :: i(:)
+   END TYPE inner
+ 
+   TYPE :: outer
+     TYPE(inner), POINTER :: inr(:)
+   END TYPE outer
+ END MODULE types
+ 
+ MODULE mymod
+   IMPLICIT NONE
+ CONTAINS
+   FUNCTION test1()
+     USE types
+     IMPLICIT NONE
+     TYPE(outer), POINTER :: test1
+     NULLIFY(test1)
+   END FUNCTION test1
+ END MODULE mymod
+ 
+ MODULE test
+   IMPLICIT NONE
+ CONTAINS
+ 
+   SUBROUTINE test2(a)
+     USE mymod
+     USE types
+     IMPLICIT NONE
+     TYPE(outer), INTENT(INOUT) :: a
+     INTEGER :: i
+     i = a%inr(1)%i(1)
+   END SUBROUTINE test2
+ 
+   SUBROUTINE test3(a)
+     USE types
+     IMPLICIT NONE
+     TYPE(outer), INTENT(IN) :: a
+   END SUBROUTINE test3
+ END MODULE test
+ ! { dg-final { cleanup-modules "types mymod test" } }