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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f8038837bdf13470b0eb2748d3a548c08e821973..7c63b51b5c144999fb69def6b34dde7877ec1d7c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+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>
 

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 0b4f92e6c6ec95f09b8be26b45591193475fd487..3d67b1c4d1a5107d9f01cbeda8f6570527081bd3 100644 (file)
--- 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 a079e86374d5c7d5e7d020bd787b07e503df585c..2aa3f294ac8507af988392b32e45676ec1fc5a73 100644 (file)
--- 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 7a4602872f1b8df408127e8def3e465b3720b558..d942fdd36d409e56694be81964b1f0f57b567e82 100644 (file)
--- 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);