1! { dg-do run } 2 3PROGRAM test_fseek 4 INTEGER, PARAMETER :: SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2, fd=10 5 INTEGER :: ierr = 0 6 INTEGER :: newline_length 7 8 ! We first need to determine if a newline is one or two characters 9 open (911,status="scratch") 10 write(911,"()") 11 newline_length = ftell(911) 12 close (911) 13 if (newline_length < 1 .or. newline_length > 2) STOP 1 14 15 open(fd, status="scratch") 16 ! expected position: one leading blank + 10 + newline 17 WRITE(fd, *) "1234567890" 18 IF (FTELL(fd) /= 11 + newline_length) STOP 2 19 20 ! move backward from current position 21 CALL FSEEK(fd, -11 - newline_length, SEEK_CUR, ierr) 22 IF (ierr /= 0 .OR. FTELL(fd) /= 0) STOP 3 23 24 ! move to negative position (error) 25 CALL FSEEK(fd, -1, SEEK_SET, ierr) 26 IF (ierr == 0 .OR. FTELL(fd) /= 0) STOP 4 27 28 ! move forward from end (11 + 10 + newline) 29 CALL FSEEK(fd, 10, SEEK_END, ierr) 30 IF (ierr /= 0 .OR. FTELL(fd) /= 21 + newline_length) STOP 5 31 32 ! set position (0) 33 CALL FSEEK(fd, 0, SEEK_SET, ierr) 34 IF (ierr /= 0 .OR. FTELL(fd) /= 0) STOP 6 35 36 ! move forward from current position 37 CALL FSEEK(fd, 5, SEEK_CUR, ierr) 38 IF (ierr /= 0 .OR. FTELL(fd) /= 5) STOP 7 39 40 CALL FSEEK(fd, HUGE(0_1), SEEK_SET, ierr) 41 IF (ierr /= 0 .OR. FTELL(fd) /= HUGE(0_1)) STOP 8 42 43 CALL FSEEK(fd, HUGE(0_2), SEEK_SET, ierr) 44 IF (ierr /= 0 .OR. FTELL(fd) /= HUGE(0_2)) STOP 9 45 46 CALL FSEEK(fd, HUGE(0_4), SEEK_SET, ierr) 47 IF (ierr /= 0 .OR. FTELL(fd) /= HUGE(0_4)) STOP 10 48 49 CALL FSEEK(fd, -HUGE(0_4), SEEK_CUR, ierr) 50 IF (ierr /= 0 .OR. FTELL(fd) /= 0) STOP 11 51END PROGRAM 52 53