2009-10-09 Janus Weil <janus@gcc.gnu.org>

	PR fortran/41585
	* decl.c (build_struct): Bugfix for CLASS components.

2009-10-09  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41585
	* gfortran.dg/class_2.f03: Extended test case.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@152608 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 899673d..f6426c7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2009-10-09  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/41585
+       * decl.c (build_struct): Bugfix for CLASS components.
+
 2009-10-09  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/41582

diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 2c378fb..1856d89 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1464,9 +1464,9 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
 {
   gfc_component *c;
 
-  /* If the current symbol is of the same derived type that we're
+  /* F03:C438/C439. If the current symbol is of the same derived type that we're
      constructing, it must have the pointer attribute.  */
-  if (current_ts.type == BT_DERIVED
+  if ((current_ts.type == BT_DERIVED || current_ts.type == BT_CLASS)
       && current_ts.u.derived == gfc_current_block ()
       && current_attr.pointer == 0)
     {

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ce6dcc2..3875b1d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-10-09  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/41585
+       * gfortran.dg/class_2.f03: Extended test case.
+
 2009-10-09  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/41582

diff --git a/gcc/testsuite/gfortran.dg/class_2.f03 b/gcc/testsuite/gfortran.dg/class_2.f03
index 070d3f7..3a75d55 100644 (file)
--- a/gcc/testsuite/gfortran.dg/class_2.f03
+++ b/gcc/testsuite/gfortran.dg/class_2.f03
@@ -34,6 +34,11 @@ abstract interface
   end subroutine
 end interface
 
+type t6
+  integer :: i
+  class(t6), allocatable :: foo  ! { dg-error "must have the POINTER attribute" }
+end type t6
+
 
 class(t1) :: o1  ! { dg-error "must be dummy, allocatable or pointer" }