re PR fortran/49112 ([OOP] Missing type-bound procedure, "duplicate save" warnings and internal compiler error)
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. From-SVN: r176971
This commit is contained in:
parent
413e50a27d
commit
0291fa2509
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
{
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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" } }
|
Loading…
Reference in New Issue