! { dg-do run }
|
! { dg-do run }
|
! This test the fix of PR19107, where character array actual
|
! This test the fix of PR19107, where character array actual
|
! arguments in derived type constructors caused an ICE.
|
! arguments in derived type constructors caused an ICE.
|
! It also checks that the scalar counterparts are OK.
|
! It also checks that the scalar counterparts are OK.
|
! Contributed by Paul Thomas pault@gcc.gnu.org
|
! Contributed by Paul Thomas pault@gcc.gnu.org
|
!
|
!
|
MODULE global
|
MODULE global
|
TYPE :: dt
|
TYPE :: dt
|
CHARACTER(4) a
|
CHARACTER(4) a
|
CHARACTER(4) b(2)
|
CHARACTER(4) b(2)
|
END TYPE
|
END TYPE
|
TYPE (dt), DIMENSION(:), ALLOCATABLE, SAVE :: c
|
TYPE (dt), DIMENSION(:), ALLOCATABLE, SAVE :: c
|
END MODULE global
|
END MODULE global
|
program char_array_structure_constructor
|
program char_array_structure_constructor
|
USE global
|
USE global
|
call alloc (2)
|
call alloc (2)
|
if ((any (c%a /= "wxyz")) .OR. &
|
if ((any (c%a /= "wxyz")) .OR. &
|
(any (c%b(1) /= "abcd")) .OR. &
|
(any (c%b(1) /= "abcd")) .OR. &
|
(any (c%b(2) /= "efgh"))) call abort ()
|
(any (c%b(2) /= "efgh"))) call abort ()
|
contains
|
contains
|
SUBROUTINE alloc (n)
|
SUBROUTINE alloc (n)
|
USE global
|
USE global
|
ALLOCATE (c(n), STAT=IALLOC_FLAG)
|
ALLOCATE (c(n), STAT=IALLOC_FLAG)
|
DO i = 1,n
|
DO i = 1,n
|
c (i) = dt ("wxyz",(/"abcd","efgh"/))
|
c (i) = dt ("wxyz",(/"abcd","efgh"/))
|
ENDDO
|
ENDDO
|
end subroutine alloc
|
end subroutine alloc
|
END program char_array_structure_constructor
|
END program char_array_structure_constructor
|
|
|
! { dg-final { cleanup-modules "global" } }
|
! { dg-final { cleanup-modules "global" } }
|
|
|
