re PR fortran/55854 (ICE on intent(out) dummy argument with unlimited polymorphic component)

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.

From-SVN: r194885

gcc/fortran/ChangeLog

+2013-01-04  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  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/55855

gcc/fortran/class.c

 /* Implementation of Fortran 2003 Polymorphism.
-   Copyright (C) 2009, 2010, 2011, 2012
+   Copyright (C) 2009, 2010, 2011, 2012, 2013
    Free Software Foundation, Inc.
    Contributed by Paul Richard Thomas <pault@gcc.gnu.org>
    and Janus Weil <janus@gcc.gnu.org>
@@ -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.  */

gcc/testsuite/ChangeLog

+2013-01-04  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.
+
 2013-01-03  Richard Sandiford  <rdsandiford@googlemail.com>
 
 	* gcc.dg/torture/tls/tls-reload-1.c (main): Make testing more thorough.

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

gcc/testsuite/gfortran.dg/unlimited_polymorphic_7.f90

+! { 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

gcc/testsuite/gfortran.dg/unlimited_polymorphic_8.f90

+! { 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" } }