From dcdc26dfd5606c0837de979ddd9b2d6c960f5102 Mon Sep 17 00:00:00 2001 From: Daniel Franke Date: Fri, 4 May 2007 14:02:18 -0400 Subject: re PR target/22539 (Internal compiler error with maximum sized array) gcc/fortran: 2007-05-04 Daniel Franke PR fortran/22539 * intrinsic.c (add_subroutines): Added FSEEK. * intrinsic.h (gfc_resolve_fseek_sub, gfc_check_fseek_sub): New. * iresolve.c (gfc_resolve_fseek_sub): New. * check.c (gfc_check_fseek_sub): New. * intrinsic.texi (FSEEK): Updated. gcc/testsuite: 2007-05-01 Daniel Franke PR fortran/22539 * gfortran.dg/fseek.f90: New test. libgfortran: 2007-05-04 Daniel Franke PR fortran/22539 * io/intrinsics.c (fseek_sub): New. * io/unix.c (fd_fseek): Change logical and physical offsets only if seek succeeds. * gfortran.map (fseek_sub): New. From-SVN: r124437 --- libgfortran/io/intrinsics.c | 28 ++++++++++++++++++++++++++++ 1 file changed, 28 insertions(+) (limited to 'libgfortran/io/intrinsics.c') diff --git a/libgfortran/io/intrinsics.c b/libgfortran/io/intrinsics.c index ab99b25..2402f48 100644 --- a/libgfortran/io/intrinsics.c +++ b/libgfortran/io/intrinsics.c @@ -228,6 +228,34 @@ flush_i8 (GFC_INTEGER_8 *unit) } } +/* FSEEK intrinsic */ + +extern void fseek_sub (int *, GFC_IO_INT *, int *, int *); +export_proto(fseek_sub); + +void +fseek_sub (int * unit, GFC_IO_INT * offset, int * whence, int * status) +{ + gfc_unit * u = find_unit (*unit); + try result = FAILURE; + + if (u != NULL && is_seekable(u->s)) + { + if (*whence == 0) + result = sseek(u->s, *offset); /* SEEK_SET */ + else if (*whence == 1) + result = sseek(u->s, file_position(u->s) + *offset); /* SEEK_CUR */ + else if (*whence == 2) + result = sseek(u->s, file_length(u->s) + *offset); /* SEEK_END */ + + unlock_unit (u); + } + + if (status) + *status = (result == FAILURE ? -1 : 0); +} + + /* FTELL intrinsic */ -- cgit v1.1