Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/deferred_type_component_2.f90 @ 158:494b0b89df80 default tip
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 25 May 2020 18:13:55 +0900 |
parents | 84e7813d76e9 |
children |
line wrap: on
line source
! { dg-do run } ! ! PR 51976: [F2003] Support deferred-length character components of derived types (allocatable string length) ! ! Contributed by Tobias Burnus <burnus@gcc.gnu.org> type t character(len=:,kind=4), allocatable :: str_comp character(len=:,kind=4), allocatable :: str_comp1 end type t type(t) :: x type(t), allocatable, dimension(:) :: array ! Check scalars allocate (x%str_comp, source = 4_"abc") call check (x%str_comp, 4_"abc") deallocate (x%str_comp) allocate (x%str_comp, source = 4_"abcdefghijklmnop") call check (x%str_comp, 4_"abcdefghijklmnop") x%str_comp = 4_"xyz" call check (x%str_comp, 4_"xyz") x%str_comp = 4_"abcdefghijklmnop" x%str_comp1 = 4_"lmnopqrst" call foo (x%str_comp1, 4_"lmnopqrst") call bar (x, 4_"abcdefghijklmnop", 4_"lmnopqrst") ! Check arrays and structure constructors allocate (array(2), source = [t(4_"abcedefg",4_"hi"), t(4_"jkl",4_"mnop")]) call check (array(1)%str_comp, 4_"abcedefg") call check (array(1)%str_comp1, 4_"hi") call check (array(2)%str_comp, 4_"jkl") call check (array(2)%str_comp1, 4_"mnop") deallocate (array) allocate (array(3), source = [x, x, x]) array(2)%str_comp = 4_"blooey" call bar (array(1), 4_"abcdefghijklmnop", 4_"lmnopqrst") call bar (array(2), 4_"blooey", 4_"lmnopqrst") call bar (array(3), 4_"abcdefghijklmnop", 4_"lmnopqrst") contains subroutine foo (chr1, chr2) character (len=*,kind=4) :: chr1, chr2 call check (chr1, chr2) end subroutine subroutine bar (a, chr1, chr2) character (len=*,kind=4) :: chr1, chr2 type(t) :: a call check (a%str_comp, chr1) call check (a%str_comp1, chr2) end subroutine subroutine check (chr1, chr2) character (len=*,kind=4) :: chr1, chr2 if (len(chr1) .ne. len (chr2)) STOP 1 if (chr1 .ne. chr2) STOP 2 end subroutine end