check.c (gfc_check_ttynam_sub, [...]): Add check functions for new intrinsics TTYNAM and ISATTY.

	* 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.
	* 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.

From-SVN: r102915

13 files changed, 235 insertions, 5 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5257714..e19247f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2005-08-09  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* 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  <jakub@redhat.com>
 
 	* 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 57b9068..fbbc96b 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -2574,6 +2574,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)
 {
   if (type_check (string, 0, BT_CHARACTER) == FAILURE)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 83e71c4..ac27105 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 67d95df..a304fbd 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 9c7a844..a10e844 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 1b14515..a6f7f27 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -712,6 +712,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)
 {
   f->ts = i->ts;
@@ -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 4e34430..f7907ec 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 d733fa3..f64b01d 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,9 +1,19 @@
+2005-08-09  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+	* 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  <jvdelisle@verizon.net>
 
-        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  <jblomqvi@cc.hut.fi>
 
 	PR fortran/22390
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index 9d6af64..d5e21c6 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 15aa5e3..f69e3b4 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 0000000..c9e2c57
--- /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 <coudert@clipper.ens.fr>
+
+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 <string.h>
+
+/* 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 3c932fc..a7dae18 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 e6b0478..eead2a2 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.