re PR fortran/41719 ([OOP] invalid: Intrinsic assignment involving polymorphic variables)

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.

From-SVN: r152919

6 files changed, 54 insertions, 3 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fd3a2bc..17bbc06 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/41648
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index d0911b4..d76c461 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -7629,6 +7629,14 @@ resolve_ordinary_assign (gfc_code *code, gfc_namespace *ns)
 	}
     }
 
+  /* 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;
 }
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ad82a2f..ffd0d7e 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+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.
+
 2009-10-16  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
 
 	* g++.dg/ipa/iinline-1.C: Use dg-add-options bind_pic_locally.
diff --git a/gcc/testsuite/gfortran.dg/class_5.f03 b/gcc/testsuite/gfortran.dg/class_5.f03
new file mode 100644
index 0000000..087d745
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_5.f03
@@ -0,0 +1,31 @@
+! { 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
+ 
\ No newline at end of file
diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_2.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_2.f03
index 57b3448..b8dc5c9 100644
--- a/gcc/testsuite/gfortran.dg/typebound_operator_2.f03
+++ b/gcc/testsuite/gfortran.dg/typebound_operator_2.f03
@@ -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
 
diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_4.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_4.f03
index 1ce2b97..835ceb6 100644
--- a/gcc/testsuite/gfortran.dg/typebound_operator_4.f03
+++ b/gcc/testsuite/gfortran.dg/typebound_operator_4.f03
@@ -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 ()