1! { dg-do run }
2! Tests the fix for pr32880, in which 'res' was deallocated
3! before it could be used in the concatenation.
4! Adapted from vst28.f95, in Lawrie Schonfeld's iso_varying_string
5! testsuite, by Tobias Burnus.
6!
7module iso_varying_string
8  type varying_string
9     character(LEN=1), dimension(:), allocatable :: chars
10  end type varying_string
11  interface assignment(=)
12     module procedure op_assign_VS_CH
13  end interface assignment(=)
14  interface operator(//)
15     module procedure op_concat_VS_CH
16  end interface operator(//)
17contains
18  elemental subroutine op_assign_VS_CH (var, exp)
19    type(varying_string), intent(out) :: var
20    character(LEN=*), intent(in)      :: exp
21    integer                      :: length
22    integer                      :: i_char
23    length = len(exp)
24    allocate(var%chars(length))
25    forall(i_char = 1:length)
26       var%chars(i_char) = exp(i_char:i_char)
27    end forall
28  end subroutine op_assign_VS_CH
29  elemental function op_concat_VS_CH (string_a, string_b) result (concat_string)
30    type(varying_string), intent(in) :: string_a
31    character(LEN=*), intent(in)     :: string_b
32    type(varying_string)             :: concat_string
33    len_string_a = size(string_a%chars)
34    allocate(concat_string%chars(len_string_a+len(string_b)))
35    if (len_string_a >0) &
36       concat_string%chars(:len_string_a) = string_a%chars
37    if (len (string_b) > 0) &
38       concat_string%chars(len_string_a+1:) = string_b
39  end function op_concat_VS_CH
40end module iso_varying_string
41
42program VST28
43  use iso_varying_string
44  character(len=10) :: char_a
45  type(VARYING_STRING) :: res
46  char_a = "abcdefghij"
47  res = char_a(5:5)
48  res = res//char_a(6:6)
49  if(size(res%chars) /= 2 .or. any(res%chars /= ['e','f'])) then
50    write(*,*) 'ERROR: should be ef, got: ', res%chars, size(res%chars)
51    STOP 1
52  end if
53end program VST28
54