1 ! { dg-do run { target fd_truncate } }
4 INTEGER, PARAMETER :: SEEK_SET
= 0, SEEK_CUR
= 1, SEEK_END
= 2, fd
=10
6 INTEGER :: newline_length
8 ! We first need to determine if a newline is one or two characters
9 open (911,status
="scratch")
11 newline_length
= ftell(911)
13 if (newline_length
< 1 .or
. newline_length
> 2) call abort()
15 ! expected position: one leading blank + 10 + newline
16 WRITE(fd
, *) "1234567890"
17 IF (FTELL(fd
) /= 11 + newline_length
) CALL abort()
19 ! move backward from current position
20 CALL FSEEK(fd
, -11 - newline_length
, SEEK_CUR
, ierr
)
21 IF (ierr
/= 0 .OR
. FTELL(fd
) /= 0) CALL abort()
23 ! move to negative position (error)
24 CALL FSEEK(fd
, -1, SEEK_SET
, ierr
)
25 IF (ierr
== 0 .OR
. FTELL(fd
) /= 0) CALL abort()
27 ! move forward from end (11 + 10 + newline)
28 CALL FSEEK(fd
, 10, SEEK_END
, ierr
)
29 IF (ierr
/= 0 .OR
. FTELL(fd
) /= 21 + newline_length
) CALL abort()
32 CALL FSEEK(fd
, 0, SEEK_SET
, ierr
)
33 IF (ierr
/= 0 .OR
. FTELL(fd
) /= 0) CALL abort()
35 ! move forward from current position
36 CALL FSEEK(fd
, 5, SEEK_CUR
, ierr
)
37 IF (ierr
/= 0 .OR
. FTELL(fd
) /= 5) CALL abort()
39 CALL FSEEK(fd
, HUGE(0_1), SEEK_SET
, ierr
)
40 IF (ierr
/= 0 .OR
. FTELL(fd
) /= HUGE(0_1)) CALL abort()
42 CALL FSEEK(fd
, HUGE(0_2), SEEK_SET
, ierr
)
43 IF (ierr
/= 0 .OR
. FTELL(fd
) /= HUGE(0_2)) CALL abort()
45 CALL FSEEK(fd
, HUGE(0_4), SEEK_SET
, ierr
)
46 IF (ierr
/= 0 .OR
. FTELL(fd
) /= HUGE(0_4)) CALL abort()
48 CALL FSEEK(fd
, -HUGE(0_4), SEEK_CUR
, ierr
)
49 IF (ierr
/= 0 .OR
. FTELL(fd
) /= 0) CALL abort()