re PR fortran/51514 ([OOP] Wrong code when passing a scalar CLASS to a TYPE)
2012-02-07 Tobias Burnus <burnus@net-b.de> PR fortran/51514 * trans-expr.c (gfc_conv_procedure_call): Add _data component for calls of scalar CLASS actuals to TYPE dummies. 2012-02-07 Tobias Burnus <burnus@net-b.de> PR fortran/51514 * gfortran.dg/class_to_type_2.f90: New. From-SVN: r183954
This commit is contained in:
parent
6009801342
commit
38cbc63a76
|
@ -1,3 +1,9 @@
|
|||
2012-02-07 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/51514
|
||||
* trans-expr.c (gfc_conv_procedure_call): Add _data component
|
||||
for calls of scalar CLASS actuals to TYPE dummies.
|
||||
|
||||
2012-02-05 Thomas König <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/48847
|
||||
|
|
|
@ -3619,6 +3619,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
|||
&& CLASS_DATA (e)->attr.dimension)
|
||||
gfc_conv_class_to_class (&parmse, e, fsym->ts, false);
|
||||
|
||||
if (fsym && fsym->ts.type == BT_DERIVED
|
||||
&& e->ts.type == BT_CLASS
|
||||
&& !CLASS_DATA (e)->attr.dimension
|
||||
&& !CLASS_DATA (e)->attr.codimension)
|
||||
parmse.expr = gfc_class_data_get (parmse.expr);
|
||||
|
||||
/* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
|
||||
allocated on entry, it must be deallocated. */
|
||||
if (fsym && fsym->attr.allocatable
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2012-02-07 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/51514
|
||||
* gfortran.dg/class_to_type_2.f90: New.
|
||||
|
||||
2012-02-06 Thomas König <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/32373
|
||||
|
|
|
@ -0,0 +1,97 @@
|
|||
! { dg-do run }
|
||||
!
|
||||
! PR fortran/51514
|
||||
!
|
||||
! Check that passing a CLASS to a TYPE works
|
||||
!
|
||||
! Based on a test case of Reinhold Bader.
|
||||
!
|
||||
|
||||
module mod_subpr
|
||||
implicit none
|
||||
|
||||
type :: foo
|
||||
integer :: i = 2
|
||||
end type
|
||||
|
||||
type, extends(foo) :: foo_1
|
||||
real :: r(2)
|
||||
end type
|
||||
|
||||
contains
|
||||
|
||||
subroutine subpr (x)
|
||||
type(foo) :: x
|
||||
x%i = 3
|
||||
end subroutine
|
||||
|
||||
elemental subroutine subpr_elem (x)
|
||||
type(foo), intent(inout):: x
|
||||
x%i = 3
|
||||
end subroutine
|
||||
|
||||
subroutine subpr_array (x)
|
||||
type(foo), intent(inout):: x(:)
|
||||
x(:)%i = 3
|
||||
end subroutine
|
||||
|
||||
subroutine subpr2 (x)
|
||||
type(foo) :: x
|
||||
if (x%i /= 55) call abort ()
|
||||
end subroutine
|
||||
|
||||
subroutine subpr2_array (x)
|
||||
type(foo) :: x(:)
|
||||
if (any(x(:)%i /= 55)) call abort ()
|
||||
end subroutine
|
||||
|
||||
function f ()
|
||||
class(foo), allocatable :: f
|
||||
allocate (f)
|
||||
f%i = 55
|
||||
end function f
|
||||
|
||||
function g () result(res)
|
||||
class(foo), allocatable :: res(:)
|
||||
allocate (res(3))
|
||||
res(:)%i = 55
|
||||
end function g
|
||||
end module
|
||||
|
||||
program prog
|
||||
use mod_subpr
|
||||
implicit none
|
||||
class(foo), allocatable :: xx, yy(:)
|
||||
|
||||
allocate (foo_1 :: xx)
|
||||
xx%i = 33
|
||||
call subpr (xx)
|
||||
if (xx%i /= 3) call abort ()
|
||||
|
||||
xx%i = 33
|
||||
call subpr_elem (xx)
|
||||
if (xx%i /= 3) call abort ()
|
||||
|
||||
call subpr (f ())
|
||||
|
||||
allocate (foo_1 :: yy(2))
|
||||
yy(:)%i = 33
|
||||
call subpr_elem (yy)
|
||||
if (any (yy%i /= 3)) call abort ()
|
||||
|
||||
yy(:)%i = 33
|
||||
call subpr_elem (yy(1))
|
||||
if (yy(1)%i /= 3) call abort ()
|
||||
|
||||
yy(:)%i = 33
|
||||
call subpr_array (yy)
|
||||
if (any (yy%i /= 3)) call abort ()
|
||||
|
||||
yy(:)%i = 33
|
||||
call subpr_array (yy(1:2))
|
||||
if (any (yy(1:2)%i /= 3)) call abort ()
|
||||
|
||||
call subpr2_array (g ())
|
||||
end program
|
||||
|
||||
! { dg-final { cleanup-modules "mod_subpr" } }
|
Loading…
Reference in New Issue