1!{ dg-do run { target fd_truncate } } 2!{ dg-options "-std=legacy" } 3! 4! Tests filling arrays from a namelist read when object list is not complete. 5! Developed from a test case provided by Christoph Jacob. 6! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>. 7program pr24794 8 9 implicit none 10 integer, parameter :: maxop=15, iunit=7 11 character*8 namea(maxop), nameb(maxop) 12 integer i, ier 13 14 namelist/ccsopr/ namea,nameb 15 namea="" 16 nameb="" 17 open (12, status="scratch", delim="apostrophe") 18 write (12, '(a)') "&ccsopr" 19 write (12, '(a)') " namea='spi01h','spi02o','spi03h','spi04o','spi05h'," 20 write (12, '(a)') " 'spi07o','spi08h','spi09h'," 21 write (12, '(a)') " nameb='spi01h','spi03h','spi05h','spi06h','spi08h'," 22 write (12, '(a)') "&end" 23 24 rewind (12) 25 read (12, nml=ccsopr, iostat=ier) 26 if (ier.ne.0) STOP 1 27 28 rewind (12) 29 write(12,nml=ccsopr) 30 31 rewind (12) 32 read (12, nml=ccsopr, iostat=ier) 33 if (ier.ne.0) STOP 2 34 35 if (namea(2).ne."spi02o ") STOP 3 36 if (namea(9).ne." ") STOP 4 37 if (namea(15).ne." ") STOP 5 38 if (nameb(1).ne."spi01h ") STOP 6 39 if (nameb(6).ne." ") STOP 7 40 if (nameb(15).ne." ") STOP 8 41 42 close (12) 43end program pr24794 44