[Patch, Fortran] PR 41719: [OOP] invalid: Intrinsic assignment involving polymorphic variables

[Janus Weil <janus@gcc.gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 654 bytes --]

Hi all,

here is a small patch which fixes this PR (rather obvious). It was
successfully regtested on x86_64-unknown-linux-gnu.

As suggested by Tobias in comment #6, I'm ignoring the F08 std on this
matter for now, and just stick to F03.

Ok for trunk?

Cheers,
Janus



2009-10-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41719
	* resolve.c (resolve_ordinary_assign): Reject intrinsic assignments
	to polymorphic variables.


2009-10-16  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/41719
	* gfortran.dg/class_5.f03: New test case.
	* gfortran.dg/typebound_operator_2.f03: Fixing invalid test case.
	* gfortran.dg/typebound_operator_4.f03: Ditto.

[-- Attachment #2: pr41719.diff --]
[-- Type: text/x-diff, Size: 1772 bytes --]

Index: gcc/testsuite/gfortran.dg/typebound_operator_2.f03
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_operator_2.f03	(Revision 152915)
+++ gcc/testsuite/gfortran.dg/typebound_operator_2.f03	(Arbeitskopie)
@@ -50,7 +50,6 @@ CONTAINS
   LOGICAL FUNCTION func (me, b) ! { dg-error "must be a SUBROUTINE" }
     CLASS(t), INTENT(OUT) :: me
     CLASS(t), INTENT(IN) :: b
-    me = t ()
     func = .TRUE.
   END FUNCTION func
 
Index: gcc/testsuite/gfortran.dg/typebound_operator_4.f03
===================================================================
--- gcc/testsuite/gfortran.dg/typebound_operator_4.f03	(Revision 152915)
+++ gcc/testsuite/gfortran.dg/typebound_operator_4.f03	(Arbeitskopie)
@@ -37,7 +37,7 @@ CONTAINS
   PURE SUBROUTINE assign_int (dest, from)
     CLASS(myint), INTENT(OUT) :: dest
     INTEGER, INTENT(IN) :: from
-    dest = myint (from)
+    dest%value = from
   END SUBROUTINE assign_int
 
   TYPE(myreal) FUNCTION add_real (a, b)
@@ -49,7 +49,7 @@ CONTAINS
   SUBROUTINE assign_real (dest, from)
     CLASS(myreal), INTENT(OUT) :: dest
     REAL, INTENT(IN) :: from
-    dest = myreal (from)
+    dest%value = from
   END SUBROUTINE assign_real
 
   SUBROUTINE in_module ()
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 152915)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -7629,6 +7629,14 @@ resolve_ordinary_assign (gfc_code *code, gfc_names
 	}
     }
 
+  /* F03:7.4.1.2.  */
+  if (lhs->ts.type == BT_CLASS)
+    {
+      gfc_error ("Variable must not be polymorphic in assignment at %L",
+		 &lhs->where);
+      return false;
+    }
+
   gfc_check_assign (lhs, rhs, 1);
   return false;
 }

[-- Attachment #3: class_5.f03 --]
[-- Type: application/octet-stream, Size: 473 bytes --]

! { dg-do compile }
!
! PR 41719: [OOP] invalid: Intrinsic assignment involving polymorphic variables
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>

 implicit none

 type t1
   integer :: a
 end type

 type, extends(t1) :: t2
   integer :: b
 end type

 class(t1),pointer :: cp
 type(t2) :: x

 x = t2(45,478)
 allocate(t2 :: cp)

 cp = x   ! { dg-error "Variable must not be polymorphic" }

 select type (cp)
 type is (t2)
   print *, cp%a, cp%b
 end select

end