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>
|
2012-01-27 Tobias Burnus <burnus@net-b.de>
|
||||||
|
|
||||||
PR fortran/52022
|
PR fortran/52022
|
||||||
|
@ -4950,7 +4950,8 @@ gfc_trans_allocate (gfc_code * code)
|
|||||||
else
|
else
|
||||||
gfc_allocate_using_malloc (&se.pre, se.expr, memsz, stat);
|
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 = build_fold_indirect_ref_loc (input_location, se.expr);
|
||||||
tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);
|
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>
|
2012-01-28 Eric Botcazou <ebotcazou@adacore.com>
|
||||||
|
|
||||||
* gcc.dg/torture/pr50444.c: Fix dg directives.
|
* 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