OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
Janus Weil 2009-10-16 23:10:43 +02:00
parent 02be8f4a8a
commit 0ae278e724
6 changed files with 54 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -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

8
gcc/fortran/resolve.c
View File

@ -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;
}

7
gcc/testsuite/ChangeLog
View File

@ -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.

31
gcc/testsuite/gfortran.dg/class_5.f03 Normal file
View File

@ -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

1
gcc/testsuite/gfortran.dg/typebound_operator_2.f03
View File

@ -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

4
gcc/testsuite/gfortran.dg/typebound_operator_4.f03
View File

@ -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 ()