1! { dg-do  run }
2! { dg-additional-options "-ffrontend-optimize -fdump-tree-original" }
3! PR fortran/35339  - make sure that I/O of an implied DO loop
4! of allocatable character arrays a) works and b) is converted
5! to a transfer_array
6program main
7    implicit none
8    integer:: i
9    integer, parameter:: N = 10
10    character(len=:), dimension(:),allocatable:: ca
11    allocate(character(len=N):: ca(3))
12    open(unit=10,status="scratch")
13    ca(1) = "foo"
14    ca(2) = "bar"
15    ca(3) = "xyzzy"
16    write (10, '(3A10)') (ca(i),i=1,3)
17    rewind (10)
18    ca(:) = ''
19    read (10, '(3A10)') (ca(i),i=1,3)
20    if (ca(1) /= 'foo' .or. ca(2) /= 'bar' .or. ca(3) /= 'xyzzy') call abort
21end program
22! { dg-final { scan-tree-dump-times "_gfortran_transfer_array" 2 "original" } }
23