re PR fortran/47728 ([OOP] ICE on invalid CLASS declaration)

2011-02-14  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47728
	* class.c (gfc_build_class_symbol): Give a fatal error on polymorphic
	arrays.
	* primary.c (gfc_match_varspec): Avoid ICE for invalid class
	declaration.

2011-02-14  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47728
	* gfortran.dg/class_38.f03: New.

From-SVN: r170144
This commit is contained in:
Janus Weil 2011-02-14 19:12:55 +01:00
parent c7dd803e61
commit ce2ab24c22
5 changed files with 38 additions and 3 deletions

View File

@ -1,3 +1,11 @@
2011-02-14 Janus Weil <janus@gcc.gnu.org>
PR fortran/47728
* class.c (gfc_build_class_symbol): Give a fatal error on polymorphic
arrays.
* primary.c (gfc_match_varspec): Avoid ICE for invalid class
declaration.
2011-02-14 Janus Weil <janus@gcc.gnu.org>
PR fortran/47349

View File

@ -186,7 +186,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
if (*as)
{
gfc_error ("Polymorphic array at %C not yet supported");
gfc_fatal_error ("Polymorphic array at %C not yet supported");
return FAILURE;
}

View File

@ -1770,8 +1770,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
if ((equiv_flag && gfc_peek_ascii_char () == '(')
|| gfc_peek_ascii_char () == '[' || sym->attr.codimension
|| (sym->attr.dimension && !sym->attr.proc_pointer
&& !gfc_is_proc_ptr_comp (primary, NULL)
|| (sym->attr.dimension && sym->ts.type != BT_CLASS
&& !sym->attr.proc_pointer && !gfc_is_proc_ptr_comp (primary, NULL)
&& !(gfc_matching_procptr_assignment
&& sym->attr.flavor == FL_PROCEDURE))
|| (sym->ts.type == BT_CLASS && sym->attr.class_ok

View File

@ -1,3 +1,8 @@
2011-02-14 Janus Weil <janus@gcc.gnu.org>
PR fortran/47728
* gfortran.dg/class_38.f03: New.
2011-02-14 Eric Botcazou <ebotcazou@adacore.com>
* gcc.dg/pr46494.c: New test.

View File

@ -0,0 +1,22 @@
! { dg-do compile }
!
! PR 47728: [OOP] ICE on invalid CLASS declaration
!
! Contributed by Arjen Markus <arjen.markus@deltares.nl>
program test_objects
implicit none
type, abstract :: shape
end type
type, extends(shape) :: rectangle
real :: width, height
end type
class(shape), dimension(2) :: object ! { dg-error "must be dummy, allocatable or pointer" }
object(1) = rectangle( 1.0, 2.0 ) ! { dg-error "Unclassifiable statement" }
end program test_objects