2011-07-31 Janus Weil <janus@gcc.gnu.org>

	PR fortran/49112
	* resolve.c (resolve_structure_cons): Don't do the full dt resolution,
	only call 'resolve_fl_derived0'.
	(resolve_typebound_procedures): Resolve typebound procedures of
	parent type.
	(resolve_fl_derived0): New function, which does a part of the work
	for 'resolve_fl_derived'.
	(resolve_fl_derived): Call 'resolve_fl_derived0' and do some additional
	things.

2011-07-31  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/49112
	* gfortran.dg/abstract_type_6.f03: Modified.
	* gfortran.dg/typebound_proc_24.f03: New.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6be5141..d2e2044 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2011-07-31  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/49112
+       * resolve.c (resolve_structure_cons): Don't do the full dt resolution,
+       only call 'resolve_fl_derived0'.
+       (resolve_typebound_procedures): Resolve typebound procedures of
+       parent type.
+       (resolve_fl_derived0): New function, which does a part of the work
+       for 'resolve_fl_derived'.
+       (resolve_fl_derived): Call 'resolve_fl_derived0' and do some additional
+       things.
+
 2011-07-30  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/48876

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e9e7bf0..b4d66cc 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -950,6 +950,9 @@ resolve_contained_functions (gfc_namespace *ns)
 }
 
 
+static gfc_try resolve_fl_derived0 (gfc_symbol *sym);
+
+
 /* Resolve all of the elements of a structure constructor and make sure that
    the types are correct. The 'init' flag indicates that the given
    constructor is an initializer.  */
@@ -965,7 +968,7 @@ resolve_structure_cons (gfc_expr *expr, int init)
   t = SUCCESS;
 
   if (expr->ts.type == BT_DERIVED)
-    resolve_symbol (expr->ts.u.derived);
+    resolve_fl_derived0 (expr->ts.u.derived);
 
   cons = gfc_constructor_first (expr->value.constructor);
   /* A constructor may have references if it is the result of substituting a
@@ -11361,9 +11364,14 @@ static gfc_try
 resolve_typebound_procedures (gfc_symbol* derived)
 {
   int op;
+  gfc_symbol* super_type;
 
   if (!derived->f2k_derived || !derived->f2k_derived->tb_sym_root)
     return SUCCESS;
+  
+  super_type = gfc_get_derived_super_type (derived);
+  if (super_type)
+    resolve_typebound_procedures (super_type);
 
   resolve_bindings_derived = derived;
   resolve_bindings_result = SUCCESS;
@@ -11475,28 +11483,17 @@ ensure_not_abstract (gfc_symbol* sub, gfc_symbol* ancestor)
 }
 
 
-/* Resolve the components of a derived type.  */
+/* Resolve the components of a derived type. This does not have to wait until
+   resolution stage, but can be done as soon as the dt declaration has been
+   parsed.  */
 
 static gfc_try
-resolve_fl_derived (gfc_symbol *sym)
+resolve_fl_derived0 (gfc_symbol *sym)
 {
   gfc_symbol* super_type;
   gfc_component *c;
 
   super_type = gfc_get_derived_super_type (sym);
-  
-  if (sym->attr.is_class && sym->ts.u.derived == NULL)
-    {
-      /* Fix up incomplete CLASS symbols.  */
-      gfc_component *data = gfc_find_component (sym, "_data", true, true);
-      gfc_component *vptr = gfc_find_component (sym, "_vptr", true, true);
-      if (vptr->ts.u.derived == NULL)
-       {
-         gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived);
-         gcc_assert (vtab);
-         vptr->ts.u.derived = vtab->ts.u.derived;
-       }
-    }
 
   /* F2008, C432. */
   if (super_type && sym->attr.coarray_comp && !super_type->attr.coarray_comp)
@@ -11508,7 +11505,7 @@ resolve_fl_derived (gfc_symbol *sym)
     }
 
   /* Ensure the extended type gets resolved before we do.  */
-  if (super_type && resolve_fl_derived (super_type) == FAILURE)
+  if (super_type && resolve_fl_derived0 (super_type) == FAILURE)
     return FAILURE;
 
   /* An ABSTRACT type must be extensible.  */
@@ -11861,14 +11858,6 @@ resolve_fl_derived (gfc_symbol *sym)
        return FAILURE;
     }
 
-  /* Resolve the type-bound procedures.  */
-  if (resolve_typebound_procedures (sym) == FAILURE)
-    return FAILURE;
-
-  /* Resolve the finalizer procedures.  */
-  if (gfc_resolve_finalizers (sym) == FAILURE)
-    return FAILURE;
-
   /* If this is a non-ABSTRACT type extending an ABSTRACT one, ensure that
      all DEFERRED bindings are overridden.  */
   if (super_type && super_type->attr.abstract && !sym->attr.abstract
@@ -11883,6 +11872,42 @@ resolve_fl_derived (gfc_symbol *sym)
 }
 
 
+/* The following procedure does the full resolution of a derived type,
+   including resolution of all type-bound procedures (if present). In contrast
+   to 'resolve_fl_derived0' this can only be done after the module has been
+   parsed completely.  */
+
+static gfc_try
+resolve_fl_derived (gfc_symbol *sym)
+{
+  if (sym->attr.is_class && sym->ts.u.derived == NULL)
+    {
+      /* Fix up incomplete CLASS symbols.  */
+      gfc_component *data = gfc_find_component (sym, "_data", true, true);
+      gfc_component *vptr = gfc_find_component (sym, "_vptr", true, true);
+      if (vptr->ts.u.derived == NULL)
+       {
+         gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived);
+         gcc_assert (vtab);
+         vptr->ts.u.derived = vtab->ts.u.derived;
+       }
+    }
+  
+  if (resolve_fl_derived0 (sym) == FAILURE)
+    return FAILURE;
+  
+  /* Resolve the type-bound procedures.  */
+  if (resolve_typebound_procedures (sym) == FAILURE)
+    return FAILURE;
+
+  /* Resolve the finalizer procedures.  */
+  if (gfc_resolve_finalizers (sym) == FAILURE)
+    return FAILURE;
+  
+  return SUCCESS;
+}
+
+
 static gfc_try
 resolve_fl_namelist (gfc_symbol *sym)
 {

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c5a6f94..4f9a1f8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2011-07-31  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/49112
+       * gfortran.dg/abstract_type_6.f03: Modified.
+       * gfortran.dg/typebound_proc_24.f03: New.
+
 2011-07-30  Paolo Carlini  <paolo.carlini@oracle.com>
 
        PR testsuite/49917

diff --git a/gcc/testsuite/gfortran.dg/abstract_type_6.f03 b/gcc/testsuite/gfortran.dg/abstract_type_6.f03
index 53116df..de1cea3 100644 (file)
--- a/gcc/testsuite/gfortran.dg/abstract_type_6.f03
+++ b/gcc/testsuite/gfortran.dg/abstract_type_6.f03
@@ -31,7 +31,7 @@ TYPE, EXTENDS(middle) :: bottom
 CONTAINS
    ! useful proc to satisfy deferred procedure in top. Because we've
    ! extended middle we wouldn't get told off if we forgot this.
-   PROCEDURE :: proc_a => bottom_a
+   PROCEDURE :: proc_a => bottom_a  ! { dg-error "must be a module procedure" }
    ! calls middle%proc_b and then provides extra behaviour
    PROCEDURE :: proc_b => bottom_b
    ! calls top_c and then provides extra behaviour

diff --git a/gcc/testsuite/gfortran.dg/typebound_proc_24.f03 b/gcc/testsuite/gfortran.dg/typebound_proc_24.f03
new file mode 100644 (file)
index 0000000..f200e0e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_proc_24.f03
@@ -0,0 +1,32 @@
+! { dg-do compile }
+!
+! PR 49112: [4.6/4.7 Regression] [OOP] Missing type-bound procedure, "duplicate save" warnings and internal compiler error
+!
+! Contributed by John <jwmwalrus@gmail.com>
+
+module datetime_mod
+
+  implicit none
+
+  type :: DateTime
+    integer :: year, month, day
+  contains
+    procedure :: getFormattedString
+  end type
+
+  type(DateTime) :: ISO_REFERENCE_DATE = DateTime(1875, 5, 20)
+
+contains
+
+  character function getFormattedString(dt)
+    class(DateTime) :: dt
+  end function
+
+  subroutine test
+    type(DateTime) :: dt
+    print *,dt%getFormattedString()
+  end subroutine
+
+end module 
+
+! { dg-final { cleanup-modules "datetime_mod" } }