re PR fortran/55763 (Issues with some simpler CLASS(*) programs)

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.

From-SVN: r194663

gcc/fortran/ChangeLog

+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

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

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);

gcc/testsuite/ChangeLog

+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

gcc/testsuite/gfortran.dg/unlimited_polymorphic_4.f03

+! { dg-do compile }
+!
+! Fix PR55763
+! Contributed by Tobias Burnus  <burnus@gcc.gnu.org>
+!
+module mpi_f08_f
+  implicit none
+  abstract interface
+    subroutine user_function( inoutvec )
+      class(*), dimension(:), intent(inout) :: inoutvec
+    end subroutine user_function
+  end interface
+end module
+
+module mod_test1
+  use mpi_f08_f
+  implicit none
+contains
+  subroutine my_function( invec )   ! { dg-error "no IMPLICIT type" }
+    class(*), dimension(:), intent(inout) :: inoutvec    ! { dg-error "not a DUMMY" }
+
+    select type (inoutvec)
+    type is (integer)
+         inoutvec = 2*inoutvec
+    end select
+  end subroutine my_function
+end module
+
+module mod_test2
+  use mpi_f08_f
+  implicit none
+contains
+  subroutine my_function( inoutvec )  ! Used to produce a BOGUS ERROR
+    class(*), dimension(:), intent(inout) :: inoutvec
+
+    select type (inoutvec)
+    type is (integer)
+         inoutvec = 2*inoutvec
+    end select
+  end subroutine my_function
+end module