@@ -1,3 +1,11 @@
+2018-08-21 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/86888
+ * decl.c (gfc_match_data_decl): Allow allocatable components of
+ indirectly recursive type.
+ * resolve.c (resolve_component): Remove two errors messages ...
+ (resolve_fl_derived): ... and replace them by a new one.
+
2018-08-16 Nathan Sidwell <nathan@acm.org>
* cpp.c (dump_macro): Use cpp_user_macro_p.
@@ -5864,8 +5864,7 @@ gfc_match_data_decl (void)
if (current_attr.pointer && gfc_comp_struct (gfc_current_state ()))
goto ok;
- if (current_attr.allocatable && gfc_current_state () == COMP_DERIVED
- && current_ts.u.derived == gfc_current_block ())
+ if (current_attr.allocatable && gfc_current_state () == COMP_DERIVED)
goto ok;
gfc_find_symbol (current_ts.u.derived->name,
@@ -14001,28 +14001,6 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
CLASS_DATA (c)->ts.u.derived
= gfc_find_dt_in_generic (CLASS_DATA (c)->ts.u.derived);
- if (!sym->attr.is_class && c->ts.type == BT_DERIVED && !sym->attr.vtype
- && c->attr.pointer && c->ts.u.derived->components == NULL
- && !c->ts.u.derived->attr.zero_comp)
- {
- gfc_error ("The pointer component %qs of %qs at %L is a type "
- "that has not been declared", c->name, sym->name,
- &c->loc);
- return false;
- }
-
- if (c->ts.type == BT_CLASS && c->attr.class_ok
- && CLASS_DATA (c)->attr.class_pointer
- && CLASS_DATA (c)->ts.u.derived->components == NULL
- && !CLASS_DATA (c)->ts.u.derived->attr.zero_comp
- && !UNLIMITED_POLY (c))
- {
- gfc_error ("The pointer component %qs of %qs at %L is a type "
- "that has not been declared", c->name, sym->name,
- &c->loc);
- return false;
- }
-
/* If an allocatable component derived type is of the same type as
the enclosing derived type, we need a vtable generating so that
the __deallocate procedure is created. */
@@ -14258,6 +14236,13 @@ resolve_fl_derived (gfc_symbol *sym)
&sym->declared_at))
return false;
+ if (sym->components == NULL && !sym->attr.zero_comp)
+ {
+ gfc_error ("Derived type %qs at %L has not been declared",
+ sym->name, &sym->declared_at);
+ return false;
+ }
+
/* Resolve the finalizer procedures. */
if (!gfc_resolve_finalizers (sym, NULL))
return false;
@@ -1,3 +1,15 @@
+2018-08-21 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/86888
+ * gfortran.dg/alloc_comp_basics_6.f90: Update an error message and add
+ an additional case.
+ * gfortran.dg/alloc_comp_basics_7.f90: New test case.
+ * gfortran.dg/class_17.f03: Update error message.
+ * gfortran.dg/class_55.f90: Ditto.
+ * gfortran.dg/dtio_11.f90: Update error messages.
+ * gfortran.dg/implicit_actual.f90: Add an error message.
+ * gfortran.dg/typebound_proc_12.f90: Update error message.
+
2018-08-21 Marek Polacek <polacek@redhat.com>
PR c++/86981, Implement -Wpessimizing-move.
@@ -5,7 +5,8 @@
! Contributed by Joost VandeVondele <Joost.VandeVondele@mat.ethz.ch>
type sysmtx_t
- type(ext_complex_t), allocatable :: S(:) ! { dg-error "has not been previously defined" }
+ type(ext_complex_t), allocatable :: S(:) ! { dg-error "has not been declared" }
+ class(some_type), allocatable :: X ! { dg-error "has not been declared" }
end type
end
new file mode 100644
@@ -0,0 +1,15 @@
+! { dg-do compile }
+!
+! PR 86888: [F08] allocatable components of indirectly recursive type
+!
+! Contributed by Janus Weil <janus@gcc.gnu.org>
+
+type :: s
+ type(t), allocatable :: x
+end type
+
+type :: t
+ type(s), allocatable :: y
+end type
+
+end
@@ -56,7 +56,7 @@ end MODULE error_stack_module
module b_module
implicit none
type::b_type
- class(not_yet_defined_type_type),pointer::b_component ! { dg-error "is a type that has not been declared" }
+ class(not_yet_defined_type_type),pointer::b_component ! { dg-error "has not been declared" }
end type b_type
end module b_module
@@ -5,7 +5,7 @@
! Contributed by Sylwester Arabas <slayoo@staszic.waw.pl>
type :: mpdata_t
- class(bcd_t), pointer :: bcx, bcy ! { dg-error "is a type that has not been declared" }
+ class(bcd_t), pointer :: bcx, bcy ! { dg-error "has not been declared" }
end type
type(mpdata_t) :: this
call this%bcx%fill_halos() ! { dg-error "is being used before it is defined" }
@@ -15,13 +15,13 @@ end
! PR77533 - used to ICE after error
module m2
type t
- type(unknown), pointer :: next ! { dg-error "is a type that has not been declared" }
+ type(unknown), pointer :: next ! { dg-error "has not been declared" }
contains
- procedure :: s
+ procedure :: s ! { dg-error "Non-polymorphic passed-object" }
generic :: write(formatted) => s
end type
contains
- subroutine s(x)
+ subroutine s(x) ! { dg-error "Too few dummy arguments" }
end
end
@@ -14,7 +14,7 @@ end module global
program snafu
! use global
- implicit type (t3) (z)
+ implicit type (t3) (z) ! { dg-error "has not been declared" }
call foo (zin) ! { dg-error "defined|Type mismatch" }
@@ -5,7 +5,7 @@
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
!
TYPE a
- TYPE(b), DIMENSION(:), POINTER :: c ! { dg-error "type that has not been declared" }
+ TYPE(b), DIMENSION(:), POINTER :: c ! { dg-error "has not been declared" }
END TYPE
TYPE(a), POINTER :: d
CALL X(d%c%e) ! { dg-error "before it is defined" }