aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/gfortran.dg/auto_pointer_array_result_1.f90
blob: 7e7cde5fbdd2b50d12e17ad8eabec7122e6dc0a6 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
! { dg-do run }
! Tests the fixes for PR25597 and PR27096.
!
! This test combines the PR testcases.
!
  character(10), dimension (2) :: implicit_result
  character(10), dimension (2) :: explicit_result
  character(10), dimension (2) :: source
  source = "abcdefghij"
  explicit_result = join_1(source)
  if (any (explicit_result .ne. source)) call abort () 

  implicit_result = reallocate_hnv (source, size(source, 1), LEN (source))
  if (any (implicit_result .ne. source)) call abort () 

contains

! This function would cause an ICE in gfc_trans_deferred_array.
  function join_1(self) result(res)
    character(len=*), dimension(:) :: self
    character(len=len(self)), dimension(:), pointer :: res
    allocate (res(2))
    res = self
  end function

! This function originally ICEd and latterly caused a runtime error.
  FUNCTION reallocate_hnv(p, n, LEN)
    CHARACTER(LEN=LEN), DIMENSION(:), POINTER :: reallocate_hnv
    character(*), dimension(:) :: p
    ALLOCATE (reallocate_hnv(n))
    reallocate_hnv = p
  END FUNCTION reallocate_hnv

end