fget.c: New file.

	* intrinsics/fget.c: New file.
	* intrinsics/ftell.c: New file.
	* io/unix.c (stream_offset): New function.
	* io/io.h: Add prototype for stream_offset.
	* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
	* Makefile.in: Regenerate.

	* intrinsic.c (add_functions): Add COMPLEX, FTELL, FGETC, FGET,
	FPUTC, FPUT, AND, XOR and OR intrinsic functions.
	(add_subroutines): Add FGETC, FGET, FPUTC, FPUT and FTELL intrinsic
	subroutines.
	* gfortran.h: Add GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET,
	GFC_ISYM_FGETC, GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL,
	GFC_ISYM_OR, GFC_ISYM_XOR.
	* iresolve.c (gfc_resolve_and, gfc_resolve_complex,
	gfc_resolve_or, gfc_resolve_fgetc, gfc_resolve_fget,
	gfc_resolve_fputc, gfc_resolve_fput, gfc_resolve_ftell,
	gfc_resolve_xor, gfc_resolve_fgetc_sub, gfc_resolve_fget_sub,
	gfc_resolve_fputc_sub, gfc_resolve_fput_sub, gfc_resolve_ftell_sub):
	New functions.
	* check.c (gfc_check_complex, gfc_check_fgetputc_sub,
	gfc_check_fgetputc, gfc_check_fgetput_sub, gfc_check_fgetput,
	gfc_check_ftell, gfc_check_ftell_sub, gfc_check_and): New functions.
	* simplify.c (gfc_simplify_and, gfc_simplify_complex, gfc_simplify_or,
	gfc_simplify_xor): New functions.
	* trans-intrinsic.c (gfc_conv_intrinsic_function): Add cases for
	GFC_ISYM_AND, GFC_ISYM_COMPLEX, GFC_ISYM_FGET, GFC_ISYM_FGETC,
	GFC_ISYM_FPUT, GFC_ISYM_FPUTC, GFC_ISYM_FTELL, GFC_ISYM_OR and
	GFC_ISYM_XOR.
	* intrinsic.h: Add prototypes for all functions added to iresolve.c,
	simplify.c and check.c.

	* gfortran.dg/complex_intrinsic_1.f90: New test.
	* gfortran.dg/complex_intrinsic_2.f90: New test.
	* gfortran.dg/fgetc_1.f90: New test.
	* gfortran.dg/fgetc_2.f90: New test.
	* gfortran.dg/fgetc_3.f90: New test.
	* gfortran.dg/ftell_1.f90: New test.
	* gfortran.dg/ftell_2.f90: New test.
	* gfortran.dg/gnu_logical_1.F: New test.
	* gfortran.dg/gnu_logical_2.f90: New test.

From-SVN: r106859

7 files changed, 278 insertions, 10 deletions

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 793d440..022ae4f 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,12 @@
+2005-11-13  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+	* intrinsics/fget.c: New file.
+	* intrinsics/ftell.c: New file.
+	* io/unix.c (stream_offset): New function.
+	* io/io.h: Add prototype for stream_offset.
+	* Makefile.am: Add intrinsics/fget.c and intrinsics/ftell.c.
+	* Makefile.in: Regenerate.
+
 2005-11-12  Steven G. Kargl  <kargls@comcast.net>
 
 	PR libgfortran/24787
diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am
index e3f2b57..4fdb4b3 100644
--- a/libgfortran/Makefile.am
+++ b/libgfortran/Makefile.am
@@ -53,8 +53,10 @@ intrinsics/eoshift0.c \
 intrinsics/eoshift2.c \
 intrinsics/etime.c \
 intrinsics/exit.c \
+intrinsics/fget.c \
 intrinsics/flush.c \
 intrinsics/fnum.c \
+intrinsics/ftell.c \
 intrinsics/gerror.c \
 intrinsics/getcwd.c \
 intrinsics/getlog.c \
diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in
index 38530d2..a8a37f5 100644
--- a/libgfortran/Makefile.in
+++ b/libgfortran/Makefile.in
@@ -167,16 +167,16 @@ am__objects_32 = close.lo file_pos.lo format.lo inquire.lo \
 am__objects_33 = associated.lo abort.lo args.lo bessel.lo \
 	c99_functions.lo chdir.lo cpu_time.lo cshift0.lo ctime.lo \
 	date_and_time.lo env.lo erf.lo eoshift0.lo eoshift2.lo \
-	etime.lo exit.lo flush.lo fnum.lo gerror.lo getcwd.lo \
-	getlog.lo getXid.lo hyper.lo hostnm.lo kill.lo ierrno.lo \
-	ishftc.lo link.lo malloc.lo mvbits.lo pack_generic.lo \
-	perror.lo signal.lo size.lo sleep.lo spread_generic.lo \
-	string_intrinsics.lo system.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 tty.lo umask.lo unlink.lo \
-	unpack_generic.lo in_pack_generic.lo in_unpack_generic.lo \
-	normalize.lo
+	etime.lo exit.lo fget.lo flush.lo fnum.lo ftell.lo gerror.lo \
+	getcwd.lo getlog.lo getXid.lo hyper.lo hostnm.lo kill.lo \
+	ierrno.lo ishftc.lo link.lo malloc.lo mvbits.lo \
+	pack_generic.lo perror.lo signal.lo size.lo sleep.lo \
+	spread_generic.lo string_intrinsics.lo system.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 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_c10.lo _abs_c16.lo \
 	_abs_i4.lo _abs_i8.lo _abs_i16.lo _abs_r4.lo _abs_r8.lo \
@@ -394,8 +394,10 @@ intrinsics/eoshift0.c \
 intrinsics/eoshift2.c \
 intrinsics/etime.c \
 intrinsics/exit.c \
+intrinsics/fget.c \
 intrinsics/flush.c \
 intrinsics/fnum.c \
+intrinsics/ftell.c \
 intrinsics/gerror.c \
 intrinsics/getcwd.c \
 intrinsics/getlog.c \
@@ -2264,12 +2266,18 @@ etime.lo: intrinsics/etime.c
 exit.lo: intrinsics/exit.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o exit.lo `test -f 'intrinsics/exit.c' || echo '$(srcdir)/'`intrinsics/exit.c
 
+fget.lo: intrinsics/fget.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fget.lo `test -f 'intrinsics/fget.c' || echo '$(srcdir)/'`intrinsics/fget.c
+
 flush.lo: intrinsics/flush.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o flush.lo `test -f 'intrinsics/flush.c' || echo '$(srcdir)/'`intrinsics/flush.c
 
 fnum.lo: intrinsics/fnum.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o fnum.lo `test -f 'intrinsics/fnum.c' || echo '$(srcdir)/'`intrinsics/fnum.c
 
+ftell.lo: intrinsics/ftell.c
+	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o ftell.lo `test -f 'intrinsics/ftell.c' || echo '$(srcdir)/'`intrinsics/ftell.c
+
 gerror.lo: intrinsics/gerror.c
 	$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o gerror.lo `test -f 'intrinsics/gerror.c' || echo '$(srcdir)/'`intrinsics/gerror.c
 
diff --git a/libgfortran/intrinsics/fget.c b/libgfortran/intrinsics/fget.c
new file mode 100644
index 0000000..8eb96e3
--- /dev/null
+++ b/libgfortran/intrinsics/fget.c
@@ -0,0 +1,173 @@
+/* Implementation of the FGET, FGETC, FPUT and FPUTC 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., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+#include <string.h>
+
+#include "../io/io.h"
+
+static const int five = 5;
+static const int six = 6;
+
+extern int PREFIX(fgetc) (const int *, char *, gfc_charlen_type);
+export_proto_np(PREFIX(fgetc));
+
+int
+PREFIX(fgetc) (const int * unit, char * c, gfc_charlen_type c_len)
+{
+  int ret;
+  size_t s;
+  gfc_unit * u = find_unit (*unit);
+
+  if (u == NULL)
+    return -1;
+
+  s = 1;
+  memset (c, ' ', c_len);
+  ret = sread (u->s, c, &s);
+
+  if (ret != 0)
+    return ret;
+
+  if (s != 1)
+    return -1;
+  else
+    return 0;
+}
+
+
+#define FGETC_SUB(kind) \
+  extern void fgetc_i ## kind ## _sub \
+    (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
+  export_proto(fgetc_i ## kind ## _sub); \
+  void fgetc_i ## kind ## _sub \
+  (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+    { if (st != NULL) \
+        *st = PREFIX(fgetc) (unit, c, c_len); \
+      else \
+        PREFIX(fgetc) (unit, c, c_len); }
+
+FGETC_SUB(1)
+FGETC_SUB(2)
+FGETC_SUB(4)
+FGETC_SUB(8)
+
+
+extern int PREFIX(fget) (char *, gfc_charlen_type);
+export_proto_np(PREFIX(fget));
+
+int
+PREFIX(fget) (char * c, gfc_charlen_type c_len)
+{
+  return PREFIX(fgetc) (&five, c, c_len);
+}
+
+
+#define FGET_SUB(kind) \
+  extern void fget_i ## kind ## _sub \
+    (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
+  export_proto(fget_i ## kind ## _sub); \
+  void fget_i ## kind ## _sub \
+  (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+    { if (st != NULL) \
+        *st = PREFIX(fgetc) (&five, c, c_len); \
+      else \
+        PREFIX(fgetc) (&five, c, c_len); }
+
+FGET_SUB(1)
+FGET_SUB(2)
+FGET_SUB(4)
+FGET_SUB(8)
+
+
+
+extern int PREFIX(fputc) (const int *, char *, gfc_charlen_type);
+export_proto_np(PREFIX(fputc));
+
+int
+PREFIX(fputc) (const int * unit, char * c,
+	       gfc_charlen_type c_len __attribute__((unused)))
+{
+  size_t s;
+  gfc_unit * u = find_unit (*unit);
+
+  if (u == NULL)
+    return -1;
+
+  s = 1;
+  return swrite (u->s, c, &s);
+}
+
+
+#define FPUTC_SUB(kind) \
+  extern void fputc_i ## kind ## _sub \
+    (const int *, char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
+  export_proto(fputc_i ## kind ## _sub); \
+  void fputc_i ## kind ## _sub \
+  (const int * unit, char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+    { if (st != NULL) \
+        *st = PREFIX(fputc) (unit, c, c_len); \
+      else \
+        PREFIX(fputc) (unit, c, c_len); }
+
+FPUTC_SUB(1)
+FPUTC_SUB(2)
+FPUTC_SUB(4)
+FPUTC_SUB(8)
+
+
+extern int PREFIX(fput) (char *, gfc_charlen_type);
+export_proto_np(PREFIX(fput));
+
+int
+PREFIX(fput) (char * c, gfc_charlen_type c_len)
+{
+  return PREFIX(fputc) (&six, c, c_len);
+}
+
+
+#define FPUT_SUB(kind) \
+  extern void fput_i ## kind ## _sub \
+    (char *, GFC_INTEGER_ ## kind *, gfc_charlen_type); \
+  export_proto(fput_i ## kind ## _sub); \
+  void fput_i ## kind ## _sub \
+  (char * c, GFC_INTEGER_ ## kind * st, gfc_charlen_type c_len) \
+    { if (st != NULL) \
+        *st = PREFIX(fputc) (&six, c, c_len); \
+      else \
+        PREFIX(fputc) (&six, c, c_len); }
+
+FPUT_SUB(1)
+FPUT_SUB(2)
+FPUT_SUB(4)
+FPUT_SUB(8)
+
diff --git a/libgfortran/intrinsics/ftell.c b/libgfortran/intrinsics/ftell.c
new file mode 100644
index 0000000..16cf275
--- /dev/null
+++ b/libgfortran/intrinsics/ftell.c
@@ -0,0 +1,67 @@
+/* Implementation of the FTELL intrinsic.
+   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., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+#include "libgfortran.h"
+
+#include <string.h>
+
+#include "../io/io.h"
+
+extern size_t PREFIX(ftell) (int *);
+export_proto_np(PREFIX(ftell));
+
+size_t
+PREFIX(ftell) (int * unit)
+{
+  gfc_unit * u = find_unit (*unit);
+  if (u == NULL)
+    return ((size_t) -1);
+  else
+    return ((size_t) stream_offset (u->s));
+}
+
+#define FTELL_SUB(kind) \
+  extern void ftell_i ## kind ## _sub (int *, GFC_INTEGER_ ## kind *); \
+  export_proto(ftell_i ## kind ## _sub); \
+  void \
+  ftell_i ## kind ## _sub (int * unit, GFC_INTEGER_ ## kind * offset) \
+  { \
+    gfc_unit * u = find_unit (*unit); \
+    if (u == NULL) \
+      *offset = -1; \
+    else \
+      *offset = stream_offset (u->s); \
+  }
+
+FTELL_SUB(1)
+FTELL_SUB(2)
+FTELL_SUB(4)
+FTELL_SUB(8)
diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index fa3335d..e262677 100644
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -520,6 +520,9 @@ internal_proto(stream_isatty);
 extern char * stream_ttyname (stream *);
 internal_proto(stream_ttyname);
 
+extern gfc_offset stream_offset (stream *s);
+internal_proto(stream_offset);
+
 extern int unit_to_fd (int);
 internal_proto(unit_to_fd);
 
diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 0fe8c4b..2f08aad 100644
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -1640,6 +1640,12 @@ stream_ttyname (stream *s)
 #endif
 }
 
+gfc_offset
+stream_offset (stream *s)
+{
+  return (((unix_stream *) s)->logical_offset);
+}
+
 
 /* How files are stored:  This is an operating-system specific issue,
    and therefore belongs here.  There are three cases to consider.