From patchwork Thu Jan  3 16:38:53 2013
Content-Type: text/plain; charset="utf-8"
MIME-Version: 1.0
Content-Transfer-Encoding: 7bit
Subject: [Fortran] PR55854/PR55763 - CLASS(*) fixes
Date: Thu, 03 Jan 2013 06:38:53 -0000
From: Tobias Burnus <burnus@net-b.de>
X-Patchwork-Id: 209280
Message-Id: <50E5B41D.6010809@net-b.de>
To: gcc patches <gcc-patches@gcc.gnu.org>, gfortran <fortran@gcc.gnu.org>

The attached patch fixes two ICE.

Regarding the unlimited_polymorphic_3.f03 change: "null(x)" is invalid 
as initialization expression (null-init). Using "ptr2 => x" would be 
valid, but it ICEs. (Cf. PR55763, comment 13)

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias


2013-01-03  Tobias Burnus  <burnus@net-b.de>

	PR fortran/55854
	PR fortran/55763
	* class.c (gfc_class_null_initializer): Fix finding the vtab.
	(gfc_find_intrinsic_vtab): Use BT_VOID for some components.

2013-01-03  Tobias Burnus  <burnus@net-b.de>

	PR fortran/55854
	PR fortran/55763
	* gfortran.dg/unlimited_polymorphic_3.f03: Remove invalid code.
	* gfortran.dg/unlimited_polymorphic_7.f90: New.
	* gfortran.dg/unlimited_polymorphic_8.f90: New.

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 61d65e7..5cbdd31 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -414,7 +414,7 @@ gfc_class_null_initializer (gfc_typespec *ts, gfc_expr *init_expr)
       && ts->u.derived->components->ts.u.derived->attr.unlimited_polymorphic;
 
   if (is_unlimited_polymorphic && init_expr)
-    vtab = gfc_find_intrinsic_vtab (&(init_expr->ts));
+    vtab = gfc_find_intrinsic_vtab (&ts->u.derived->components->ts);
   else
     vtab = gfc_find_derived_vtab (ts->u.derived);
 
@@ -2224,9 +2224,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
 		goto cleanup;
 	      c->attr.pointer = 1;
 	      c->attr.access = ACCESS_PRIVATE;
-	      /* Avoid segfaults because due to character length.   */
-	      c->ts.type = ts->type == BT_CHARACTER ? BT_VOID : ts->type;
-	      c->ts.kind = ts->kind;
+	      c->ts.type = BT_VOID;
 	      c->initializer = gfc_get_null_expr (NULL);
 
 	      /* Add component _def_init.  */
@@ -2234,9 +2232,7 @@ gfc_find_intrinsic_vtab (gfc_typespec *ts)
 		goto cleanup;
 	      c->attr.pointer = 1;
 	      c->attr.access = ACCESS_PRIVATE;
-	      /* Avoid segfaults due to missing character length.   */
-	      c->ts.type = ts->type == BT_CHARACTER ? BT_VOID : ts->type;
-	      c->ts.kind = ts->kind;
+	      c->ts.type = BT_VOID;
 	      c->initializer = gfc_get_null_expr (NULL);
 
 	      /* Add component _copy.  */
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03
index 5ed9897..05a4b3f 100644
--- a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03
@@ -28,9 +28,7 @@ contains
     end type t
     type(t), pointer :: x
     class(*), pointer :: ptr1 => null() ! pointer initialization
-    class(*), pointer :: ptr2 => null(x) ! pointer initialization
     if (same_type_as (ptr1, x) .neqv. .FALSE.) call abort
-    if (same_type_as (ptr2, x) .neqv. .TRUE.) call abort
   end subroutine bar
 
 end program main
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_7.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_7.f90
new file mode 100644
index 0000000..3bd4d4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_7.f90
@@ -0,0 +1,19 @@
+! { dg-do compile }
+!
+! PR fortran/55763
+!
+! Contributed by Harald Anlauf
+!
+
+module gfcbug121
+  implicit none
+  type myobj
+     class(*), allocatable :: x
+   contains
+     procedure :: print
+  end type myobj
+contains
+  subroutine print(this)
+    class(myobj) :: this
+  end subroutine print
+end module gfcbug121
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90
new file mode 100644
index 0000000..e0fa931
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90
@@ -0,0 +1,20 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! PR fortran/55854
+!
+! Contributed by Damian Rouson
+!
+
+  type foo
+    class(*), allocatable :: x
+  end type
+contains
+  subroutine bar(this)
+    type(foo), intent(out) :: this
+  end
+end
+
+! { dg-final { scan-tree-dump-times "foo.0.x._data = 0B;" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo.0.x._vptr = .* &__vtab__.tar;" 1 "original" } }
+! { dg-final { cleanup-tree-dump "optimized" } }