re PR fortran/16581 (gfortran F90 bit intrinsics don't work with integer*{1,2,8})

2004-12-12  Steven G. Kargl  <kargls@comcast.net>

	PR fortran/16581
	* check.c (gfc_check_iand, gfc_check_ibclr, gfc_check_ibits,
	gfc_check_ibset, gfc_check_ieor, gfc_check_ior): Remove default
	integer kind check; Issue error for -std=f95 when needed.
	* intrinsic.c (add_functions): Change ieor from GFC_STD_GNU to
	GFC_STD_F95.
	* iresolve.c (gfc_resolve_iand, gfc_resolve_ieor, gfc_resolve_ior):
	Promote arguments to same kind.

From-SVN: r92063

4 files changed, 88 insertions, 26 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f803883..7c63b51 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,15 @@
 2004-12-12  Steven G. Kargl  <kargls@comcast.net>
+
+	PR fortran/16581
+	* check.c (gfc_check_iand, gfc_check_ibclr, gfc_check_ibits,
+	gfc_check_ibset, gfc_check_ieor, gfc_check_ior): Remove default
+	integer kind check; Issue error for -std=f95 when needed.
+	* intrinsic.c (add_functions): Change ieor from GFC_STD_GNU to
+	GFC_STD_F95.
+	* iresolve.c (gfc_resolve_iand, gfc_resolve_ieor, gfc_resolve_ior):
+	Promote arguments to same kind.
+
+2004-12-12  Steven G. Kargl  <kargls@comcast.net>
 	Paul Brook  <paul@codesourcery.com>
 
 	PR fortran/16222
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 0b4f92e6..3d67b1c 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -809,13 +809,19 @@ try
 gfc_check_iand (gfc_expr * i, gfc_expr * j)
 {
 
-  if (type_check (i, 0, BT_INTEGER) == FAILURE
-      || type_check (j, 1, BT_INTEGER) == FAILURE)
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
     return FAILURE;
 
-  if (same_type_check (i, 0, j, 1) == FAILURE)
+  if (type_check (j, 1, BT_INTEGER) == FAILURE)
     return FAILURE;
 
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
+                          &i->where) == FAILURE)
+	return FAILURE;
+    }
+
   return SUCCESS;
 }
 
@@ -824,9 +830,10 @@ try
 gfc_check_ibclr (gfc_expr * i, gfc_expr * pos)
 {
 
-  if (type_check (i, 0, BT_INTEGER) == FAILURE
-      || type_check (pos, 1, BT_INTEGER) == FAILURE
-      || kind_value_check (pos, 1, gfc_default_integer_kind) == FAILURE)
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (pos, 1, BT_INTEGER) == FAILURE)
     return FAILURE;
 
   return SUCCESS;
@@ -837,10 +844,13 @@ try
 gfc_check_ibits (gfc_expr * i, gfc_expr * pos, gfc_expr * len)
 {
 
-  if (type_check (i, 0, BT_INTEGER) == FAILURE
-      || type_check (pos, 1, BT_INTEGER) == FAILURE
-      || kind_value_check (pos, 1, gfc_default_integer_kind) == FAILURE
-      || type_check (len, 2, BT_INTEGER) == FAILURE)
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (pos, 1, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (len, 2, BT_INTEGER) == FAILURE)
     return FAILURE;
 
   return SUCCESS;
@@ -851,9 +861,10 @@ try
 gfc_check_ibset (gfc_expr * i, gfc_expr * pos)
 {
 
-  if (type_check (i, 0, BT_INTEGER) == FAILURE
-      || type_check (pos, 1, BT_INTEGER) == FAILURE
-      || kind_value_check (pos, 1, gfc_default_integer_kind) == FAILURE)
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
+    return FAILURE;
+
+  if (type_check (pos, 1, BT_INTEGER) == FAILURE)
     return FAILURE;
 
   return SUCCESS;
@@ -875,13 +886,19 @@ try
 gfc_check_ieor (gfc_expr * i, gfc_expr * j)
 {
 
-  if (type_check (i, 0, BT_INTEGER) == FAILURE
-      || type_check (j, 1, BT_INTEGER) == FAILURE)
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
     return FAILURE;
 
-  if (same_type_check (i, 0, j, 1) == FAILURE)
+  if (type_check (j, 1, BT_INTEGER) == FAILURE)
     return FAILURE;
 
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
+                          &i->where) == FAILURE)
+	return FAILURE;
+    }
+
   return SUCCESS;
 }
 
@@ -924,13 +941,19 @@ try
 gfc_check_ior (gfc_expr * i, gfc_expr * j)
 {
 
-  if (type_check (i, 0, BT_INTEGER) == FAILURE
-      || type_check (j, 1, BT_INTEGER) == FAILURE)
+  if (type_check (i, 0, BT_INTEGER) == FAILURE)
     return FAILURE;
 
-  if (same_type_check (i, 0, j, 1) == FAILURE)
+  if (type_check (j, 1, BT_INTEGER) == FAILURE)
     return FAILURE;
 
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (gfc_notify_std (GFC_STD_GNU, "Extension: Different type kinds at %L",
+                          &i->where) == FAILURE)
+    return FAILURE;
+    }
+
   return SUCCESS;
 }
 
diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.c
index a079e86..2aa3f29 100644
--- a/gcc/fortran/intrinsic.c
+++ b/gcc/fortran/intrinsic.c
@@ -1375,11 +1375,11 @@ add_functions (void)
 
   make_generic ("ichar", GFC_ISYM_ICHAR, GFC_STD_F77);
 
-  add_sym_2 ("ieor", 1, 1, BT_INTEGER, di, GFC_STD_GNU,
+  add_sym_2 ("ieor", 1, 1, BT_INTEGER, di, GFC_STD_F95,
 	     gfc_check_ieor, gfc_simplify_ieor, gfc_resolve_ieor,
 	     i, BT_INTEGER, di, REQUIRED, j, BT_INTEGER, di, REQUIRED);
 
-  make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_GNU);
+  make_generic ("ieor", GFC_ISYM_IEOR, GFC_STD_F95);
 
   add_sym_3 ("index", 1, 1, BT_INTEGER, di, GFC_STD_F77,
 	     gfc_check_index, gfc_simplify_index, NULL,
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 7a46028..d942fdd 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -619,8 +619,18 @@ gfc_resolve_getuid (gfc_expr * f)
 }
 
 void
-gfc_resolve_iand (gfc_expr * f, gfc_expr * i, gfc_expr * j ATTRIBUTE_UNUSED)
+gfc_resolve_iand (gfc_expr * f, gfc_expr * i, gfc_expr * j)
 {
+  /* If the kind of i and j are different, then g77 cross-promoted the
+     kinds to the largest value.  The Fortran 95 standard requires the 
+     kinds to match.  */
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (i->ts.kind == gfc_kind_max (i,j))
+	gfc_convert_type(j, &i->ts, 2);
+      else
+	gfc_convert_type(i, &j->ts, 2);
+    }
 
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__iand_%d", i->ts.kind);
@@ -676,9 +686,18 @@ gfc_resolve_idnint (gfc_expr * f, gfc_expr * a)
 
 
 void
-gfc_resolve_ieor (gfc_expr * f, gfc_expr * i,
-		  gfc_expr * j ATTRIBUTE_UNUSED)
+gfc_resolve_ieor (gfc_expr * f, gfc_expr * i, gfc_expr * j)
 {
+  /* If the kind of i and j are different, then g77 cross-promoted the
+     kinds to the largest value.  The Fortran 95 standard requires the 
+     kinds to match.  */
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (i->ts.kind == gfc_kind_max (i,j))
+	gfc_convert_type(j, &i->ts, 2);
+      else
+	gfc_convert_type(i, &j->ts, 2);
+    }
 
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__ieor_%d", i->ts.kind);
@@ -686,9 +705,18 @@ gfc_resolve_ieor (gfc_expr * f, gfc_expr * i,
 
 
 void
-gfc_resolve_ior (gfc_expr * f, gfc_expr * i,
-		 gfc_expr * j ATTRIBUTE_UNUSED)
+gfc_resolve_ior (gfc_expr * f, gfc_expr * i, gfc_expr * j)
 {
+  /* If the kind of i and j are different, then g77 cross-promoted the
+     kinds to the largest value.  The Fortran 95 standard requires the 
+     kinds to match.  */
+  if (i->ts.kind != j->ts.kind)
+    {
+      if (i->ts.kind == gfc_kind_max (i,j))
+	gfc_convert_type(j, &i->ts, 2);
+      else
+	gfc_convert_type(i, &j->ts, 2);
+    }
 
   f->ts = i->ts;
   f->value.function.name = gfc_get_string ("__ior_%d", i->ts.kind);