--- /dev/null
+! { dg-do run }
+! PR25349 Check T editing. Test case from PR submitted by Thomas Koenig
+! Contributed by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+ program main
+ character(len=10) line
+ write (line,'(1X,A,T1,A)') 'A','B'
+ if (line.ne.'BA') call abort()
+ end
! Left tabbing, followed by X or T-tabbing to the right would
! cause spaces to be overwritten on output data.
! Contributed by Paul Thomas <pault@gcc.gnu.org>
- program tl_editting
- character*10 :: line
- character*10 :: aline = "abcdefxyij"
- character*2 :: bline = "gh"
- character*10 :: cline = "abcdefghij"
- write (line, '(a10,tl6,2x,a2)') aline, bline
- if (line.ne.cline) call abort ()
- end program tl_editting
+! PR25349 Revised by Jerry DeLisle <jvdelisle@gcc.gnu.org>
+program tl_editting
+ character*10 :: line, many(5), s
+ character*10 :: aline = "abcdefxyij"
+ character*2 :: bline = "gh"
+ character*10 :: cline = "abcdefghij"
+
+! Character unit test
+ write (line, '(a10,tl6,2x,a2)') aline, bline
+ if (line.ne.cline) call abort ()
+
+! Character array unit test
+ many = "0123456789"
+ write(many(1:5:2), '(a10,tl6,2x,a2)') aline, bline, aline, bline, aline,&
+ &bline
+ if (many(1).ne.cline) call abort ()
+ if (many(3).ne.cline) call abort ()
+ if (many(5).ne.cline) call abort ()
+
+! File unit test
+ write (10, '(a10,tl6,2x,a2)') aline, bline
+ rewind(10)
+ read(10, '(a)') s
+ if (s.ne.cline) call abort
+
+end program tl_editting
--- /dev/null
+! { dg-do run }
+! PR25264 Verify that the internal unit, str, is not cleared
+! before it is needed elsewhere. This is an extension.
+! Test derived from test case by JPR. Contributed by
+! Jerry DeLisle <jvdelisle@verizon.net>.
+program write_padding
+ character(len=10) :: str
+ real :: atime
+ str = '123'
+ write( str, '(a3,i1)' ) trim(str),4
+ if (str.ne."1234") call abort()
+end program write_padding
+