mirrors/gcc
0
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2024-11-27 05:44:15 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

re PR fortran/86888 ([F08] allocatable components of indirectly recursive type)

Browse Source 
fix PR 86888

2018-08-22  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-22  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.

From-SVN: r263782
This commit is contained in:
Janus Weil 2018-08-22 19:10:00 +02:00
parent b56b07639b
commit 00cad178a3
11 changed files with 52 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -1,3 +1,11 @@
2018-08-22 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-21 Janne Blomqvist <jb@gcc.gnu.org>
* trans-intrinsic.c (gfc_conv_intrinsic_minmax): Use

3
gcc/fortran/decl.c
View File

@ -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,

29
gcc/fortran/resolve.c
View File

@ -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;

12
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,15 @@
2018-08-22 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-22 Martin Sebor <msebor@redhat.com>
PR middle-end/87052

3
gcc/testsuite/gfortran.dg/alloc_comp_basics_6.f90
View File

@ -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

15
gcc/testsuite/gfortran.dg/alloc_comp_basics_7.f90 Normal file
View File

@ -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

2
gcc/testsuite/gfortran.dg/class_17.f03
View File

@ -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

2
gcc/testsuite/gfortran.dg/class_55.f90
View File

@ -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" }

6
gcc/testsuite/gfortran.dg/dtio_11.f90
View File

@ -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

2
gcc/testsuite/gfortran.dg/implicit_actual.f90
View File

@ -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" }

2
gcc/testsuite/gfortran.dg/typebound_proc_12.f90
View File

@ -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" }