re PR fortran/51972 ([OOP] Wrong code as _copy does not honor CLASS components)
2012-01-28 Tobias Burnus <burnus@net-b.de> PR fortran/51972 * trans-stmt.c (gfc_trans_allocate): Properly check whether we have a BT_CLASS which needs to be memset. 2012-01-28 Tobias Burnus <burnus@net-b.de> PR fortran/51972 * gfortran.dg/class_allocate_12.f90: New. From-SVN: r183668
This commit is contained in:
parent
ce590933fe
commit
3bfe6da98d
@ -1,3 +1,9 @@
|
||||
2012-01-28 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/51972
|
||||
* trans-stmt.c (gfc_trans_allocate): Properly check whether
|
||||
we have a BT_CLASS which needs to be memset.
|
||||
|
||||
2012-01-27 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/52022
|
||||
|
@ -4950,7 +4950,8 @@ gfc_trans_allocate (gfc_code * code)
|
||||
else
|
||||
gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat);
|
||||
|
||||
if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)
|
||||
if (al->expr->ts.type == BT_DERIVED
|
||||
&& expr->ts.u.derived->attr.alloc_comp)
|
||||
{
|
||||
tmp = build_fold_indirect_ref_loc (input_location, se.expr);
|
||||
tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);
|
||||
|
@ -1,3 +1,8 @@
|
||||
2012-01-28 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/51972
|
||||
* gfortran.dg/class_allocate_12.f90: New.
|
||||
|
||||
2012-01-28 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gcc.dg/torture/pr50444.c: Fix dg directives.
|
||||
|
97
gcc/testsuite/gfortran.dg/class_allocate_12.f90
Normal file
97
gcc/testsuite/gfortran.dg/class_allocate_12.f90
Normal file
@ -0,0 +1,97 @@
|
||||
! { dg-do run }
|
||||
!
|
||||
! PR fortran/51972
|
||||
!
|
||||
! Contributed by Damian Rouson
|
||||
!
|
||||
! TODO: Remove the STOP line below after fixing
|
||||
! The remaining issue of the PR
|
||||
!
|
||||
|
||||
module surrogate_module
|
||||
type ,abstract :: surrogate
|
||||
end type
|
||||
end module
|
||||
|
||||
module strategy_module
|
||||
use surrogate_module
|
||||
|
||||
type :: strategy
|
||||
end type
|
||||
end module
|
||||
|
||||
module integrand_module
|
||||
use surrogate_module
|
||||
use strategy_module
|
||||
implicit none
|
||||
|
||||
type ,abstract, extends(surrogate) :: integrand
|
||||
class(strategy), allocatable :: quadrature
|
||||
end type
|
||||
end module integrand_module
|
||||
|
||||
module lorenz_module
|
||||
use strategy_module
|
||||
use integrand_module
|
||||
implicit none
|
||||
|
||||
type ,extends(integrand) :: lorenz
|
||||
real, dimension(:), allocatable :: state
|
||||
contains
|
||||
procedure ,public :: assign => assign_lorenz
|
||||
end type
|
||||
contains
|
||||
type(lorenz) function constructor(initial_state, this_strategy)
|
||||
real ,dimension(:) ,intent(in) :: initial_state
|
||||
class(strategy) ,intent(in) :: this_strategy
|
||||
constructor%state=initial_state
|
||||
allocate (constructor%quadrature, source=this_strategy)
|
||||
end function
|
||||
|
||||
subroutine assign_lorenz(lhs,rhs)
|
||||
class(lorenz) ,intent(inout) :: lhs
|
||||
class(integrand) ,intent(in) :: rhs
|
||||
select type(rhs)
|
||||
class is (lorenz)
|
||||
allocate (lhs%quadrature, source=rhs%quadrature)
|
||||
lhs%state=rhs%state
|
||||
end select
|
||||
end subroutine
|
||||
end module lorenz_module
|
||||
|
||||
module runge_kutta_2nd_module
|
||||
use surrogate_module,only : surrogate
|
||||
use strategy_module ,only : strategy
|
||||
use integrand_module,only : integrand
|
||||
implicit none
|
||||
|
||||
type, extends(strategy) ,public :: runge_kutta_2nd
|
||||
contains
|
||||
procedure, nopass :: integrate
|
||||
end type
|
||||
contains
|
||||
subroutine integrate(this)
|
||||
class(surrogate) ,intent(inout) :: this
|
||||
class(integrand) ,allocatable :: this_half
|
||||
|
||||
select type (this)
|
||||
class is (integrand)
|
||||
allocate (this_half, source=this)
|
||||
end select
|
||||
STOP 'SUCESS!' ! See TODO above
|
||||
end subroutine
|
||||
end module
|
||||
|
||||
program main
|
||||
use lorenz_module
|
||||
use runge_kutta_2nd_module ,only : runge_kutta_2nd, integrate
|
||||
implicit none
|
||||
|
||||
type(runge_kutta_2nd) :: timed_lorenz_integrator
|
||||
type(lorenz) :: attractor
|
||||
|
||||
attractor = constructor( [1., 1., 1.] , timed_lorenz_integrator)
|
||||
call integrate(attractor)
|
||||
end program main
|
||||
|
||||
! { dg-final { cleanup-modules "surrogate_module strategy_module integrand_module runge_kutta_2nd_module" } }
|
Loading…
Reference in New Issue
Block a user