diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index fd3a2bc6dd5..17bbc06e833 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2009-10-16 Janus Weil + + PR fortran/41719 + * resolve.c (resolve_ordinary_assign): Reject intrinsic assignments + to polymorphic variables. + 2009-10-16 Paul Thomas PR fortran/41648 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d0911b485ab..d76c461d28a 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 ad82a2fde87..ffd0d7ebb2f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2009-10-16 Janus Weil + + 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 * 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 00000000000..087d745aec7 --- /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 + + 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 57b34486313..b8dc5c9d104 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 1ce2b97a0d7..835ceb63ff0 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 ()