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:
parent
02be8f4a8a
commit
0ae278e724
|
@ -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>
|
2009-10-16 Paul Thomas <pault@gcc.gnu.org>
|
||||||
|
|
||||||
PR fortran/41648
|
PR fortran/41648
|
||||||
|
|
|
@ -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);
|
gfc_check_assign (lhs, rhs, 1);
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
|
@ -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>
|
2009-10-16 Kaveh R. Ghazi <ghazi@caip.rutgers.edu>
|
||||||
|
|
||||||
* g++.dg/ipa/iinline-1.C: Use dg-add-options bind_pic_locally.
|
* g++.dg/ipa/iinline-1.C: Use dg-add-options bind_pic_locally.
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -50,7 +50,6 @@ CONTAINS
|
||||||
LOGICAL FUNCTION func (me, b) ! { dg-error "must be a SUBROUTINE" }
|
LOGICAL FUNCTION func (me, b) ! { dg-error "must be a SUBROUTINE" }
|
||||||
CLASS(t), INTENT(OUT) :: me
|
CLASS(t), INTENT(OUT) :: me
|
||||||
CLASS(t), INTENT(IN) :: b
|
CLASS(t), INTENT(IN) :: b
|
||||||
me = t ()
|
|
||||||
func = .TRUE.
|
func = .TRUE.
|
||||||
END FUNCTION func
|
END FUNCTION func
|
||||||
|
|
||||||
|
|
|
@ -37,7 +37,7 @@ CONTAINS
|
||||||
PURE SUBROUTINE assign_int (dest, from)
|
PURE SUBROUTINE assign_int (dest, from)
|
||||||
CLASS(myint), INTENT(OUT) :: dest
|
CLASS(myint), INTENT(OUT) :: dest
|
||||||
INTEGER, INTENT(IN) :: from
|
INTEGER, INTENT(IN) :: from
|
||||||
dest = myint (from)
|
dest%value = from
|
||||||
END SUBROUTINE assign_int
|
END SUBROUTINE assign_int
|
||||||
|
|
||||||
TYPE(myreal) FUNCTION add_real (a, b)
|
TYPE(myreal) FUNCTION add_real (a, b)
|
||||||
|
@ -49,7 +49,7 @@ CONTAINS
|
||||||
SUBROUTINE assign_real (dest, from)
|
SUBROUTINE assign_real (dest, from)
|
||||||
CLASS(myreal), INTENT(OUT) :: dest
|
CLASS(myreal), INTENT(OUT) :: dest
|
||||||
REAL, INTENT(IN) :: from
|
REAL, INTENT(IN) :: from
|
||||||
dest = myreal (from)
|
dest%value = from
|
||||||
END SUBROUTINE assign_real
|
END SUBROUTINE assign_real
|
||||||
|
|
||||||
SUBROUTINE in_module ()
|
SUBROUTINE in_module ()
|
||||||
|
|
Loading…
Reference in New Issue