1! { dg-do run }
2! Tests the fixes for PR25597 and PR27096.
3!
4! This test combines the PR testcases.
5!
6  character(10), dimension (2) :: implicit_result
7  character(10), dimension (2) :: explicit_result
8  character(10), dimension (2) :: source
9  source = "abcdefghij"
10  explicit_result = join_1(source)
11  if (any (explicit_result .ne. source)) call abort ()
12
13  implicit_result = reallocate_hnv (source, size(source, 1), LEN (source))
14  if (any (implicit_result .ne. source)) call abort ()
15
16contains
17
18! This function would cause an ICE in gfc_trans_deferred_array.
19  function join_1(self) result(res)
20    character(len=*), dimension(:) :: self
21    character(len=len(self)), dimension(:), pointer :: res
22    allocate (res(2))
23    res = self
24  end function
25
26! This function originally ICEd and latterly caused a runtime error.
27  FUNCTION reallocate_hnv(p, n, LEN)
28    CHARACTER(LEN=LEN), DIMENSION(:), POINTER :: reallocate_hnv
29    character(*), dimension(:) :: p
30    ALLOCATE (reallocate_hnv(n))
31    reallocate_hnv = p
32  END FUNCTION reallocate_hnv
33
34end
35
36
37