re PR fortran/47085 ([OOP] Problem in allocate( SOURCE=) for polymorphic component)

2010-12-30  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47085
	* match.c (gfc_match_allocate): Check for 'class_ok'.
	* primary.c (gfc_match_varspec): Ditto.


2010-12-30  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/47085
	* gfortran.dg/allocate_class_1.f90: New.

From-SVN: r168340
This commit is contained in:
Janus Weil 2010-12-30 12:53:35 +01:00
parent 7831434fbf
commit 22061030a7
5 changed files with 25 additions and 2 deletions

View file

@ -1,3 +1,9 @@
2010-12-30 Janus Weil <janus@gcc.gnu.org>
PR fortran/47085
* match.c (gfc_match_allocate): Check for 'class_ok'.
* primary.c (gfc_match_varspec): Ditto.
2010-12-29 Thomas Koenig <tkoenig@gcc.gnu.org>
* dump_parse_tree.c (show_components): Show

View file

@ -2956,7 +2956,7 @@ gfc_match_allocate (void)
b1 = !(tail->expr->ref
&& (tail->expr->ref->type == REF_COMPONENT
|| tail->expr->ref->type == REF_ARRAY));
if (sym && sym->ts.type == BT_CLASS)
if (sym && sym->ts.type == BT_CLASS && sym->attr.class_ok)
b2 = !(CLASS_DATA (sym)->attr.allocatable
|| CLASS_DATA (sym)->attr.class_pointer);
else

View file

@ -1774,7 +1774,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag,
&& !gfc_is_proc_ptr_comp (primary, NULL)
&& !(gfc_matching_procptr_assignment
&& sym->attr.flavor == FL_PROCEDURE))
|| (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.dimension))
|| (sym->ts.type == BT_CLASS && sym->attr.class_ok
&& CLASS_DATA (sym)->attr.dimension))
{
/* In EQUIVALENCE, we don't know yet whether we are seeing
an array, character variable or array of character

View file

@ -1,3 +1,8 @@
2010-12-30 Janus Weil <janus@gcc.gnu.org>
PR fortran/47085
* gfortran.dg/allocate_class_1.f90: New.
2010-12-30 Kai Tietz <kai.tietz@onevision.com>
PR testsuite/47050

View file

@ -0,0 +1,11 @@
! { dg-do compile }
!
! PR 47085: [OOP] Problem in allocate( SOURCE=) for polymorphic component
!
! Contributed by Janus Weil <janus@gcc.gnu.org>
type :: t0
end type
class(t0) :: x ! { dg-error "must be dummy, allocatable or pointer" }
allocate(x) ! { dg-error "is not a nonprocedure pointer or an allocatable variable" }
end