mirror of
https://github.com/autc04/Retro68.git
synced 2024-09-28 18:56:06 +00:00
48 lines
1.3 KiB
Fortran
48 lines
1.3 KiB
Fortran
! { dg-do compile }
|
|
! Checks the fix for PR34008, in which INTENT(INOUT) was disallowed
|
|
! for the first argument of assign_m, whereas both INOUT and OUT
|
|
! should be allowed.
|
|
!
|
|
! Contributed by Harald Anlauf <anlauf@gmx.de>
|
|
!
|
|
module mo_memory
|
|
implicit none
|
|
type t_mi
|
|
logical :: alloc = .false.
|
|
end type t_mi
|
|
type t_m
|
|
type(t_mi) :: i ! meta data
|
|
real, pointer :: ptr (:,:,:,:) => NULL ()
|
|
end type t_m
|
|
|
|
interface assignment (=)
|
|
module procedure assign_m
|
|
end interface
|
|
contains
|
|
elemental subroutine assign_m (y, x)
|
|
!---------------------------------------
|
|
! overwrite intrinsic assignment routine
|
|
!---------------------------------------
|
|
type (t_m), intent(inout) :: y
|
|
type (t_m), intent(in) :: x
|
|
y% i = x% i
|
|
if (y% i% alloc) y% ptr = x% ptr
|
|
end subroutine assign_m
|
|
end module mo_memory
|
|
|
|
module gfcbug74
|
|
use mo_memory, only: t_m, assignment (=)
|
|
implicit none
|
|
type t_atm
|
|
type(t_m) :: m(42)
|
|
end type t_atm
|
|
contains
|
|
subroutine assign_atm_to_atm (y, x)
|
|
type (t_atm), intent(inout) :: y
|
|
type (t_atm), intent(in) :: x
|
|
integer :: i
|
|
! do i=1,42; y% m(i) = x% m(i); end do ! Works
|
|
y% m = x% m ! ICE
|
|
end subroutine assign_atm_to_atm
|
|
end module gfcbug74
|