char_array_structure_constructor.f90

来自「用于进行gcc测试」· F90 代码 · 共 31 行

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

! { dg-final { cleanup-modules "global" } }