1! { dg-do run } 2! 3! PR fortran/60066 4! 5! Contributed by F Martinez Fadrique <fmartinez@gmv.com> 6! 7! Fixed by the patch for PR59906 but adds another, different test. 8! 9module m_assertion_character 10 implicit none 11 type :: t_assertion_character 12 character(len=8) :: name 13 contains 14 procedure :: assertion_character 15 procedure :: write => assertion_array_write 16 end type t_assertion_character 17contains 18 impure elemental subroutine assertion_character( ast, name ) 19 class(t_assertion_character), intent(out) :: ast 20 character(len=*), intent(in) :: name 21 ast%name = name 22 end subroutine assertion_character 23 subroutine assertion_array_write( ast, unit ) 24 class(t_assertion_character), intent(in) :: ast 25 character(*), intent(inOUT) :: unit 26 write(unit,*) trim (unit(2:len(unit)))//trim (ast%name) 27 end subroutine assertion_array_write 28end module m_assertion_character 29 30module m_assertion_array_character 31 use m_assertion_character 32 implicit none 33 type :: t_assertion_array_character 34 type(t_assertion_character), dimension(:), allocatable :: rast 35 contains 36 procedure :: assertion_array_character 37 procedure :: write => assertion_array_character_write 38 end type t_assertion_array_character 39contains 40 subroutine assertion_array_character( ast, name, nast ) 41 class(t_assertion_array_character), intent(out) :: ast 42 character(len=*), intent(in) :: name 43 integer, intent(in) :: nast 44 integer :: i 45 allocate ( ast%rast(nast) ) 46 call ast%rast%assertion_character ( name ) 47 end subroutine assertion_array_character 48 subroutine assertion_array_character_write( ast, unit ) 49 class(t_assertion_array_character), intent(in) :: ast 50 CHARACTER(*), intent(inOUT) :: unit 51 integer :: i 52 do i = 1, size (ast%rast) 53 call ast%rast(i)%write (unit) 54 end do 55 end subroutine assertion_array_character_write 56end module m_assertion_array_character 57 58program main 59 use m_assertion_array_character 60 implicit none 61 type(t_assertion_array_character) :: ast 62 character(len=8) :: name 63 character (26) :: line = '' 64 name = 'test' 65 call ast%assertion_array_character ( name, 5 ) 66 call ast%write (line) 67 if (line(2:len (line)) .ne. "testtesttesttesttest") call abort 68end program main 69