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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2b050b1..591a289 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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
 2013-01-03  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/55855

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 61d65e7..607af10 100644 (file)
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -1,5 +1,5 @@
 /* Implementation of Fortran 2003 Polymorphism.
 /* 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>
    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)
       && 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);
 
   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;
                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.  */
              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;
                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.  */
              c->initializer = gfc_get_null_expr (NULL);
 
              /* Add component _copy.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ed8cd65..5357e0b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+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.
 2013-01-03  Richard Sandiford  <rdsandiford@googlemail.com>
 
        * gcc.dg/torture/tls/tls-reload-1.c (main): Make testing more thorough.

diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_3.f03
index 5ed9897..05a4b3f 100644 (file)
--- 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
     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 (ptr1, x) .neqv. .FALSE.) call abort

-    if (same_type_as (ptr2, x) .neqv. .TRUE.) call abort

   end subroutine bar
 
 end program main
   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 (file)
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 (file)
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" } }