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