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, 106 insertions, 0 deletions

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 7c9a6dc..b6931f1 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -450,6 +450,31 @@ gfc_simplify_anint (gfc_expr * e, gfc_expr * k)
 
 
 gfc_expr *
+gfc_simplify_and (gfc_expr * x, gfc_expr * y)
+{
+  gfc_expr *result;
+  int kind;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind;
+  if (x->ts.type == BT_INTEGER)
+    {
+      result = gfc_constant_result (BT_INTEGER, kind, &x->where);
+      mpz_and (result->value.integer, x->value.integer, y->value.integer);
+    }
+  else /* BT_LOGICAL */
+    {
+      result = gfc_constant_result (BT_LOGICAL, kind, &x->where);
+      result->value.logical = x->value.logical && y->value.logical;
+    }
+
+  return range_check (result, "AND");
+}
+
+
+gfc_expr *
 gfc_simplify_dnint (gfc_expr * e)
 {
   gfc_expr *result;
@@ -724,6 +749,34 @@ gfc_simplify_cmplx (gfc_expr * x, gfc_expr * y, gfc_expr * k)
 
 
 gfc_expr *
+gfc_simplify_complex (gfc_expr * x, gfc_expr * y)
+{
+  int kind;
+
+  if (x->expr_type != EXPR_CONSTANT
+      || (y != NULL && y->expr_type != EXPR_CONSTANT))
+    return NULL;
+
+  if (x->ts.type == BT_INTEGER)
+    {
+      if (y->ts.type == BT_INTEGER)
+	kind = gfc_default_real_kind;
+      else
+	kind = y->ts.kind;
+    }
+  else
+    {
+      if (y->ts.type == BT_REAL)
+	kind = (x->ts.kind > y->ts.kind) ? x->ts.kind : y->ts.kind;
+      else
+	kind = x->ts.kind;
+    }
+
+  return simplify_cmplx ("COMPLEX", x, y, kind);
+}
+
+
+gfc_expr *
 gfc_simplify_conjg (gfc_expr * e)
 {
   gfc_expr *result;
@@ -2480,6 +2533,31 @@ gfc_simplify_null (gfc_expr * mold)
 
 
 gfc_expr *
+gfc_simplify_or (gfc_expr * x, gfc_expr * y)
+{
+  gfc_expr *result;
+  int kind;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind;
+  if (x->ts.type == BT_INTEGER)
+    {
+      result = gfc_constant_result (BT_INTEGER, kind, &x->where);
+      mpz_ior (result->value.integer, x->value.integer, y->value.integer);
+    }
+  else /* BT_LOGICAL */
+    {
+      result = gfc_constant_result (BT_LOGICAL, kind, &x->where);
+      result->value.logical = x->value.logical || y->value.logical;
+    }
+
+  return range_check (result, "OR");
+}
+
+
+gfc_expr *
 gfc_simplify_precision (gfc_expr * e)
 {
   gfc_expr *result;
@@ -3706,6 +3784,34 @@ gfc_simplify_verify (gfc_expr * s, gfc_expr * set, gfc_expr * b)
   return result;
 }
 
+
+gfc_expr *
+gfc_simplify_xor (gfc_expr * x, gfc_expr * y)
+{
+  gfc_expr *result;
+  int kind;
+
+  if (x->expr_type != EXPR_CONSTANT || y->expr_type != EXPR_CONSTANT)
+    return NULL;
+
+  kind = x->ts.kind > y->ts.kind ? x->ts.kind : y->ts.kind;
+  if (x->ts.type == BT_INTEGER)
+    {
+      result = gfc_constant_result (BT_INTEGER, kind, &x->where);
+      mpz_xor (result->value.integer, x->value.integer, y->value.integer);
+    }
+  else /* BT_LOGICAL */
+    {
+      result = gfc_constant_result (BT_LOGICAL, kind, &x->where);
+      result->value.logical = (x->value.logical && ! y->value.logical)
+			      || (! x->value.logical && y->value.logical);
+    }
+
+  return range_check (result, "XOR");
+}
+
+
+
 /****************** Constant simplification *****************/
 
 /* Master function to convert one constant to another.  While this is