diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 5257714ee41..e19247f9b4f 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2005-08-09 Francois-Xavier Coudert + + * check.c (gfc_check_ttynam_sub, gfc_check_isatty): Add check + functions for new intrinsics TTYNAM and ISATTY. + * intrinsic.c (add_functions, add_subroutines): Add new + intrinsics. + * intrinsic.h: Add prototypes for new check and resolve + functions. + * iresolve.c (gfc_resolve_isatty, gfc_resolve_ttynam_sub): New + resolve functions for intrinsics TTYNAM and ISATTY. + * gfortran.h (gfc_generic_isym_id): Add symbol for ISATTY. + * trans-intrinsic.c: Add case for GFC_ISYM_ISATTY. + 2005-08-09 Jakub Jelinek * scanner.c (preprocessor_line): Don't write beyond the end of flag diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 57b906855b5..fbbc96bf29d 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -2573,6 +2573,38 @@ gfc_check_hostnm_sub (gfc_expr * name, gfc_expr * status) } +try +gfc_check_ttynam_sub (gfc_expr * unit, gfc_expr * name) +{ + if (scalar_check (unit, 0) == FAILURE) + return FAILURE; + + if (type_check (unit, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (type_check (name, 1, BT_CHARACTER) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + +try +gfc_check_isatty (gfc_expr * unit) +{ + if (unit == NULL) + return FAILURE; + + if (type_check (unit, 0, BT_INTEGER) == FAILURE) + return FAILURE; + + if (scalar_check (unit, 0) == FAILURE) + return FAILURE; + + return SUCCESS; +} + + try gfc_check_perror (gfc_expr * string) { diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 83e71c44535..ac271054b05 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -335,6 +335,7 @@ enum gfc_generic_isym_id GFC_ISYM_INT, GFC_ISYM_IOR, GFC_ISYM_IRAND, + GFC_ISYM_ISATTY, GFC_ISYM_ISHFT, GFC_ISYM_ISHFTC, GFC_ISYM_KILL, diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c index 67d95df2f3a..a304fbd667c 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.c @@ -1468,6 +1468,12 @@ add_functions (void) make_generic ("irand", GFC_ISYM_IRAND, GFC_STD_GNU); + add_sym_1 ("isatty", 0, 0, BT_LOGICAL, dl, GFC_STD_GNU, + gfc_check_isatty, NULL, gfc_resolve_isatty, + ut, BT_INTEGER, di, REQUIRED); + + make_generic ("isatty", GFC_ISYM_ISATTY, GFC_STD_GNU); + add_sym_2 ("ishft", 1, 1, BT_INTEGER, di, GFC_STD_F95, gfc_check_ishft, gfc_simplify_ishft, gfc_resolve_ishft, i, BT_INTEGER, di, REQUIRED, sh, BT_INTEGER, di, REQUIRED); @@ -2247,6 +2253,10 @@ add_subroutines (void) c, BT_INTEGER, di, OPTIONAL, cr, BT_INTEGER, di, OPTIONAL, cm, BT_INTEGER, di, OPTIONAL); + add_sym_2s ("ttynam", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, + gfc_check_ttynam_sub, NULL, gfc_resolve_ttynam_sub, + ut, BT_INTEGER, di, REQUIRED, c, BT_CHARACTER, dc, REQUIRED); + add_sym_2s ("umask", 0, 1, BT_UNKNOWN, 0, GFC_STD_GNU, gfc_check_umask_sub, NULL, gfc_resolve_umask_sub, val, BT_INTEGER, di, REQUIRED, num, BT_INTEGER, di, OPTIONAL); diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 9c7a844845c..a10e84465ad 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -70,6 +70,7 @@ try gfc_check_index (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_int (gfc_expr *, gfc_expr *); try gfc_check_ior (gfc_expr *, gfc_expr *); try gfc_check_irand (gfc_expr *); +try gfc_check_isatty (gfc_expr *); try gfc_check_ishft (gfc_expr *, gfc_expr *); try gfc_check_ishftc (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_kill (gfc_expr *, gfc_expr *); @@ -148,6 +149,7 @@ try gfc_check_symlnk_sub (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_sleep_sub (gfc_expr *); try gfc_check_stat_sub (gfc_expr *, gfc_expr *, gfc_expr *); try gfc_check_system_sub (gfc_expr *, gfc_expr *); +try gfc_check_ttynam_sub (gfc_expr *, gfc_expr *); try gfc_check_umask_sub (gfc_expr *, gfc_expr *); try gfc_check_unlink_sub (gfc_expr *, gfc_expr *); @@ -316,6 +318,7 @@ void gfc_resolve_ichar (gfc_expr *, gfc_expr *); void gfc_resolve_idnint (gfc_expr *, gfc_expr *); void gfc_resolve_int (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ior (gfc_expr *, gfc_expr *, gfc_expr *); +void gfc_resolve_isatty (gfc_expr *, gfc_expr *); void gfc_resolve_ishft (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ishftc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_kill (gfc_expr *, gfc_expr *, gfc_expr *); @@ -402,6 +405,7 @@ void gfc_resolve_sleep_sub (gfc_code *); void gfc_resolve_stat_sub (gfc_code *); void gfc_resolve_system_clock (gfc_code *); void gfc_resolve_system_sub (gfc_code *); +void gfc_resolve_ttynam_sub (gfc_code *); void gfc_resolve_umask_sub (gfc_code *); void gfc_resolve_unlink_sub (gfc_code *); diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 1b14515350d..a6f7f27776e 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -711,6 +711,26 @@ gfc_resolve_int (gfc_expr * f, gfc_expr * a, gfc_expr * kind) } +void +gfc_resolve_isatty (gfc_expr * f, gfc_expr * u) +{ + gfc_typespec ts; + + f->ts.type = BT_LOGICAL; + f->ts.kind = gfc_default_integer_kind; + if (u->ts.kind != gfc_c_int_kind) + { + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + ts.derived = NULL; + ts.cl = NULL; + gfc_convert_type (u, &ts, 2); + } + + f->value.function.name = gfc_get_string (PREFIX("isatty_l%d"), f->ts.kind); +} + + void gfc_resolve_ishft (gfc_expr * f, gfc_expr * i, gfc_expr * shift) { @@ -1939,6 +1959,25 @@ gfc_resolve_fstat_sub (gfc_code * c) c->resolved_sym = gfc_get_intrinsic_sub_symbol (name); } + +void +gfc_resolve_ttynam_sub (gfc_code * c) +{ + gfc_typespec ts; + + if (c->ext.actual->expr->ts.kind != gfc_c_int_kind) + { + ts.type = BT_INTEGER; + ts.kind = gfc_c_int_kind; + ts.derived = NULL; + ts.cl = NULL; + gfc_convert_type (c->ext.actual->expr, &ts, 2); + } + + c->resolved_sym = gfc_get_intrinsic_sub_symbol (PREFIX("ttynam_sub")); +} + + /* Resolve the UMASK intrinsic subroutine. */ void diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 4e3443088d5..f7907ecd92d 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2996,6 +2996,7 @@ gfc_conv_intrinsic_function (gfc_se * se, gfc_expr * expr) case GFC_ISYM_KILL: case GFC_ISYM_IERRNO: case GFC_ISYM_IRAND: + case GFC_ISYM_ISATTY: case GFC_ISYM_LINK: case GFC_ISYM_MATMUL: case GFC_ISYM_RAND: diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index d733fa36b6c..f64b01d4994 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,9 +1,19 @@ +2005-08-09 Francois-Xavier Coudert + * Makefile.am: Add file intrinsics/tty.c to Makefile process. + * Makefile.in: Regenerate. + * io/io.h: Prototypes for new functions stream_isatty and + stream_ttyname. + * io/unix (stream_isatty, stream_ttyname): New functions to call + isatty() and ttyname() on a given unit. + * intrinsics/tty.c: New file to implement g77 intrinsics TTYNAM + and ISATTY. + 2005-08-08 Jerry DeLisle - PR libfortran/23154 - * io/transfer.c (data_transfer_init): Initialize - current_unit->bytes_left for a read. - + PR libfortran/23154 + * io/transfer.c (data_transfer_init): Initialize + current_unit->bytes_left for a read. + 2005-08-07 Janne Blomqvist PR fortran/22390 diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index 9d6af64726f..d5e21c60386 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -85,6 +85,7 @@ intrinsics/symlnk.c \ intrinsics/system_clock.c \ intrinsics/time.c \ intrinsics/transpose_generic.c \ +intrinsics/tty.c \ intrinsics/umask.c \ intrinsics/unlink.c \ intrinsics/unpack_generic.c \ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index 15aa5e30f9e..f69e3b4b1a6 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -140,7 +140,7 @@ am__objects_33 = associated.lo abort.lo args.lo bessel.lo \ rand.lo random.lo rename.lo reshape_generic.lo \ reshape_packed.lo selected_int_kind.lo selected_real_kind.lo \ stat.lo symlnk.lo system_clock.lo time.lo transpose_generic.lo \ - umask.lo unlink.lo unpack_generic.lo in_pack_generic.lo \ + tty.lo umask.lo unlink.lo unpack_generic.lo in_pack_generic.lo \ in_unpack_generic.lo normalize.lo am__objects_34 = am__objects_35 = _abs_c4.lo _abs_c8.lo _abs_i4.lo _abs_i8.lo \ @@ -379,6 +379,7 @@ intrinsics/symlnk.c \ intrinsics/system_clock.c \ intrinsics/time.c \ intrinsics/transpose_generic.c \ +intrinsics/tty.c \ intrinsics/umask.c \ intrinsics/unlink.c \ intrinsics/unpack_generic.c \ @@ -1385,6 +1386,9 @@ time.lo: intrinsics/time.c transpose_generic.lo: intrinsics/transpose_generic.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transpose_generic.lo `test -f 'intrinsics/transpose_generic.c' || echo '$(srcdir)/'`intrinsics/transpose_generic.c +tty.lo: intrinsics/tty.c + $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o tty.lo `test -f 'intrinsics/tty.c' || echo '$(srcdir)/'`intrinsics/tty.c + umask.lo: intrinsics/umask.c $(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o umask.lo `test -f 'intrinsics/umask.c' || echo '$(srcdir)/'`intrinsics/umask.c diff --git a/libgfortran/intrinsics/tty.c b/libgfortran/intrinsics/tty.c new file mode 100644 index 00000000000..c9e2c579e5b --- /dev/null +++ b/libgfortran/intrinsics/tty.c @@ -0,0 +1,97 @@ +/* Implementation of the ISATTY and TTYNAM g77 intrinsics. + Copyright (C) 2005 Free Software Foundation, Inc. + Contributed by François-Xavier Coudert + +This file is part of the GNU Fortran 95 runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public +License as published by the Free Software Foundation; either +version 2 of the License, or (at your option) any later version. + +In addition to the permissions in the GNU General Public License, the +Free Software Foundation gives you unlimited permission to link the +compiled version of this file into combinations with other programs, +and to distribute those combinations without any restriction coming +from the use of this file. (The General Public License restrictions +do apply in other respects; for example, they cover modification of +the file, and distribution when not linked into a combine +executable.) + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public +License along with libgfortran; see the file COPYING. If not, +write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +#include "config.h" +#include "libgfortran.h" +#include "../io/io.h" +#include + +/* LOGICAL FUNCTION ISATTY(UNIT) + INTEGER, INTENT(IN) :: UNIT */ + +extern GFC_LOGICAL_4 isatty_l4 (int *); +export_proto(isatty_l4); + +GFC_LOGICAL_4 +isatty_l4 (int *unit) +{ + gfc_unit *u; + + u = find_unit (*unit); + if (u != NULL) + return (GFC_LOGICAL_4) stream_isatty (u->s); + else + return 0; +} + + +extern GFC_LOGICAL_8 isatty_l8 (int *); +export_proto(isatty_l8); + +GFC_LOGICAL_8 +isatty_l8 (int *unit) +{ + gfc_unit *u; + + u = find_unit (*unit); + if (u != NULL) + return (GFC_LOGICAL_8) stream_isatty (u->s); + else + return 0; +} + + +/* SUBROUTINE TTYNAM(UNIT,NAME) + INTEGER,SCALAR,INTENT(IN) :: UNIT + CHARACTER,SCALAR,INTENT(OUT) :: NAME */ + +extern void ttynam_sub (int *, char *, gfc_charlen_type); +export_proto(ttynam_sub); + +void +ttynam_sub (int *unit, char * name, gfc_charlen_type name_len) +{ + gfc_unit *u; + char * n; + int i; + + memset (name, ' ', name_len); + u = find_unit (*unit); + if (u != NULL) + { + n = stream_ttyname (u->s); + if (n != NULL) + { + i = 0; + while (*n && i < name_len) + name[i++] = *(n++); + } + } +} diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h index 3c932fc6303..a7dae184061 100644 --- a/libgfortran/io/io.h +++ b/libgfortran/io/io.h @@ -496,6 +496,12 @@ internal_proto(empty_internal_buffer); extern try flush (stream *); internal_proto(flush); +extern int stream_isatty (stream *); +internal_proto(stream_isatty); + +extern char * stream_ttyname (stream *); +internal_proto(stream_ttyname); + extern int unit_to_fd (int); internal_proto(unit_to_fd); diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c index e6b0478af23..eead2a28339 100644 --- a/libgfortran/io/unix.c +++ b/libgfortran/io/unix.c @@ -1536,6 +1536,18 @@ flush (stream *s) return fd_flush( (unix_stream *) s); } +int +stream_isatty (stream *s) +{ + return isatty (((unix_stream *) s)->fd); +} + +char * +stream_ttyname (stream *s) +{ + return ttyname (((unix_stream *) s)->fd); +} + /* How files are stored: This is an operating-system specific issue, and therefore belongs here. There are three cases to consider.