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

1 files changed, 156 insertions, 0 deletions

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index bf81e9f..bc757ff 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -632,6 +632,33 @@ gfc_check_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * kind)
 
 
 try
+gfc_check_complex (gfc_expr * x, gfc_expr * y)
+{
+  if (x->ts.type != BT_INTEGER && x->ts.type != BT_REAL)
+    {
+      gfc_error (
+	"'%s' argument of '%s' intrinsic at %L must be INTEGER or REAL",
+	gfc_current_intrinsic_arg[0], gfc_current_intrinsic, &x->where);
+      return FAILURE;
+    }
+  if (scalar_check (x, 0) == FAILURE)
+    return FAILURE;
+
+  if (y->ts.type != BT_INTEGER && y->ts.type != BT_REAL)
+    {
+      gfc_error (
+	"'%s' argument of '%s' intrinsic at %L must be INTEGER or REAL",
+	gfc_current_intrinsic_arg[1], gfc_current_intrinsic, &y->where);
+      return FAILURE;
+    }
+  if (scalar_check (y, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
 gfc_check_count (gfc_expr * mask, gfc_expr * dim)
 {
   if (logical_array_check (mask, 0) == FAILURE)
@@ -2003,6 +2030,64 @@ gfc_check_spread (gfc_expr * source, gfc_expr * dim, gfc_expr * ncopies)
 }
 
 
+/* Functions for checking FGETC, FPUTC, FGET and FPUT (subroutines and
+   functions).  */
+try
+gfc_check_fgetputc_sub (gfc_expr * unit, gfc_expr * c, gfc_expr * status)
+{
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (c, 1, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 2, BT_INTEGER) == FAILURE
+      || kind_value_check (status, 2, gfc_default_integer_kind) == FAILURE
+      || scalar_check (status, 2) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
+gfc_check_fgetputc (gfc_expr * unit, gfc_expr * c)
+{
+  return gfc_check_fgetputc_sub (unit, c, NULL);
+}
+
+
+try
+gfc_check_fgetput_sub (gfc_expr * c, gfc_expr * status)
+{
+  if (type_check (c, 0, BT_CHARACTER) == FAILURE)
+    return FAILURE;
+
+  if (status == NULL)
+    return SUCCESS;
+
+  if (type_check (status, 1, BT_INTEGER) == FAILURE
+      || kind_value_check (status, 1, gfc_default_integer_kind) == FAILURE
+      || scalar_check (status, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
+gfc_check_fgetput (gfc_expr * c)
+{
+  return gfc_check_fgetput_sub (c, NULL);
+}
+
+
 try
 gfc_check_fstat (gfc_expr * unit, gfc_expr * array)
 {
@@ -2054,6 +2139,38 @@ gfc_check_fstat_sub (gfc_expr * unit, gfc_expr * array, gfc_expr * status)
 
 
 try
+gfc_check_ftell (gfc_expr * unit)
+{
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
+gfc_check_ftell_sub (gfc_expr * unit, gfc_expr * offset)
+{
+  if (type_check (unit, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (unit, 0) == FAILURE)
+    return FAILURE;
+
+  if (type_check (offset, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (offset, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}
+
+
+try
 gfc_check_stat (gfc_expr * name, gfc_expr * array)
 {
   if (type_check (name, 0, BT_CHARACTER) == FAILURE)
@@ -2922,3 +3039,42 @@ gfc_check_system_sub (gfc_expr * cmd, gfc_expr * status)
 
   return SUCCESS;
 }
+
+
+/* This is used for the GNU intrinsics AND, OR and XOR.  */
+try
+gfc_check_and (gfc_expr * i, gfc_expr * j)
+{
+  if (i->ts.type != BT_INTEGER && i->ts.type != BT_LOGICAL)
+    {
+      gfc_error (
+	"'%s' argument of '%s' intrinsic at %L must be INTEGER or LOGICAL",
+	gfc_current_intrinsic_arg[0], gfc_current_intrinsic, &i->where);
+      return FAILURE;
+    }
+
+  if (j->ts.type != BT_INTEGER && j->ts.type != BT_LOGICAL)
+    {
+      gfc_error (
+	"'%s' argument of '%s' intrinsic at %L must be INTEGER or LOGICAL",
+	gfc_current_intrinsic_arg[1], gfc_current_intrinsic, &j->where);
+      return FAILURE;
+    }
+
+  if (i->ts.type != j->ts.type)
+    {
+      gfc_error ("'%s' and '%s' arguments of '%s' intrinsic at %L must "
+		 "have the same type", gfc_current_intrinsic_arg[0],
+		 gfc_current_intrinsic_arg[1], gfc_current_intrinsic,
+		 &j->where);
+      return FAILURE;
+    }
+
+  if (scalar_check (i, 0) == FAILURE)
+    return FAILURE;
+
+  if (scalar_check (j, 1) == FAILURE)
+    return FAILURE;
+
+  return SUCCESS;
+}