2012-12-21 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/55763
	* match.c (select_type_set_tmp): Return is a derived type or
	class typespec has no derived type.
	* resolve.c (resolve_fl_var_and_proc): Exclude select type
	temporaries from 'pointer'.
	(resolve_symbol): Exclude select type temporaries from tests
	for assumed size and assumed rank.

2012-12-21  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/55763
	* gfortran.dg/unlimited_polymorphic_4.f03: New test.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index db7383c..7924fe7 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2012-12-21  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/55763
+       * match.c (select_type_set_tmp): Return is a derived type or
+       class typespec has no derived type.
+       * resolve.c (resolve_fl_var_and_proc): Exclude select type
+       temporaries from 'pointer'.
+       (resolve_symbol): Exclude select type temporaries from tests
+       for assumed size and assumed rank.
+
 2012-12-20  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/36044

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index 6322fae..ca8f08c 100644 (file)
--- a/gcc/fortran/match.c
+++ b/gcc/fortran/match.c
@@ -5293,6 +5293,9 @@ select_type_set_tmp (gfc_typespec *ts)
 
   if (tmp == NULL)
     {
+      if (!ts->u.derived)
+       return;
+
       if (ts->type == BT_CLASS)
        sprintf (name, "__tmp_class_%s", ts->u.derived->name);
       else

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 6208a81..fce6f73 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11056,7 +11056,7 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
        }
       else
        {
-         pointer = sym->attr.pointer;
+         pointer = sym->attr.pointer && !sym->attr.select_type_temporary;
          allocatable = sym->attr.allocatable;
          dimension = sym->attr.dimension;
        }
@@ -13315,7 +13315,7 @@ resolve_symbol (gfc_symbol *sym)
       gcc_assert (as->type != AS_IMPLIED_SHAPE);
       if (((as->type == AS_ASSUMED_SIZE && !as->cp_was_assumed)
           || as->type == AS_ASSUMED_SHAPE)
-         && sym->attr.dummy == 0)
+         && !sym->attr.dummy && !sym->attr.select_type_temporary)
        {
          if (as->type == AS_ASSUMED_SIZE)
            gfc_error ("Assumed size array at %L must be a dummy argument",
@@ -13326,7 +13326,8 @@ resolve_symbol (gfc_symbol *sym)
          return;
        }
       /* TS 29113, C535a.  */
-      if (as->type == AS_ASSUMED_RANK && !sym->attr.dummy)
+      if (as->type == AS_ASSUMED_RANK && !sym->attr.dummy
+         && !sym->attr.select_type_temporary)
        {
          gfc_error ("Assumed-rank array at %L must be a dummy argument",
                     &sym->declared_at);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a51f09e..f720276 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-12-21  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/55763
+       * gfortran.dg/unlimited_polymorphic_4.f03: New test.
+
 2012-12-21  Richard Biener  <rguenther@suse.de>
 
        PR tree-optimization/52996

diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_4.f03 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_4.f03
new file mode 100644 (file)
index 0000000..d289b69
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_4.f03
@@ -0,0 +1,41 @@
+! { dg-do compile }\r
+!\r
+! Fix PR55763\r
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>\r
+!\r
+module mpi_f08_f\r
+  implicit none\r
+  abstract interface\r
+    subroutine user_function( inoutvec )\r
+      class(*), dimension(:), intent(inout) :: inoutvec\r
+    end subroutine user_function\r
+  end interface\r
+end module\r
+\r
+module mod_test1\r
+  use mpi_f08_f\r
+  implicit none\r
+contains\r
+  subroutine my_function( invec )   ! { dg-error "no IMPLICIT type" }\r
+    class(*), dimension(:), intent(inout) :: inoutvec    ! { dg-error "not a DUMMY" }\r
+\r
+    select type (inoutvec)\r
+    type is (integer)\r
+         inoutvec = 2*inoutvec\r
+    end select\r
+  end subroutine my_function\r
+end module\r
+\r
+module mod_test2\r
+  use mpi_f08_f\r
+  implicit none\r
+contains\r
+  subroutine my_function( inoutvec )  ! Used to produce a BOGUS ERROR\r
+    class(*), dimension(:), intent(inout) :: inoutvec\r
+\r
+    select type (inoutvec)\r
+    type is (integer)\r
+         inoutvec = 2*inoutvec\r
+    end select\r
+  end subroutine my_function\r
+end module\r