1! { dg-do run }
2! { dg-options "-ffrontend-optimize" }
3! PR 62214 - this used to give the wrong result.
4! Original test case by Oliver Fuhrer
5PROGRAM test
6  IMPLICIT NONE
7  CHARACTER(LEN=20)   :: fullNames(2)
8  CHARACTER(LEN=255)  :: pathName
9  CHARACTER(LEN=5)    :: fileNames(2)
10
11  pathName = "/dir1/dir2/"
12  fileNames = (/ "file1", "file2" /)
13  fullNames = SPREAD(TRIM(pathName),1,2) // fileNames
14  if (fullNames(1) /= '/dir1/dir2/file1' .or. &
15       & fullnames(2) /= '/dir1/dir2/file2') call abort
16END PROGRAM test
17