This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

PATCH: Potential patch for PR fortran/6491


PR 6491 requires that a .and. of two logical*4 variables, when using
-fugly-logint, be implemented using an integer AND operation.  The
result is then assigned to a logical*4 variable.

PR 12633 requires that the result of a .or. of two logical variables,
when using -fugly-logint, produce a logical result.

To me, the natural way to reconcile these requirements is, when using
-fugly-logint, to convert boolean operands to integer, perform the
operation, and then convert the result back to boolean.  The initial
patch for PR 6491 implemented the first of these operations--the
conversion to integer--but led to PR 12633 because it did not convert
the result back to boolean.  A followon patch for PR 6491 attempted to
do the reverse conversion, but failed.

This patch implements both conversions.  I've tested it by running the
g77 testsuite.

However, I haven't done any FORTRAN programming for 20 years, so
somebody had better look over this patch before it is applied.

Also, I expect that a test case should be added.  I haven't done that
yet.

Ian


2004-01-12  Ian Lance Taylor  <ian@wasabisystems.com>

	* expr.c (ffeexpr_reduce_): When handling AND, OR, and XOR, and
	when using -fugly-logint, if both operands are logical, convert
	the result back to logical.
	(ffeexpr_reduced_ugly2log_): Add bothlogical parameter.  Change
	all callers.  Convert logical operands to integer.


Index: expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/f/expr.c,v
retrieving revision 1.30
diff -p -u -r1.30 expr.c
--- expr.c	24 Nov 2003 21:48:08 -0000	1.30
+++ expr.c	12 Jan 2004 19:16:44 -0000
@@ -309,7 +309,8 @@ static ffebld ffeexpr_reduced_ugly1log_ 
 static ffebld ffeexpr_reduced_ugly2_ (ffebld reduced, ffeexprExpr_ l,
 				      ffeexprExpr_ op, ffeexprExpr_ r);
 static ffebld ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l,
-					 ffeexprExpr_ op, ffeexprExpr_ r);
+					 ffeexprExpr_ op, ffeexprExpr_ r,
+					 bool *);
 static ffelexHandler ffeexpr_find_close_paren_ (ffelexToken t,
 						ffelexHandler after);
 static ffelexHandler ffeexpr_nil_finished_ (ffelexToken t);
@@ -8802,6 +8803,7 @@ ffeexpr_reduce_ (void)
   ffebld expr;
   ffebld left_expr;
   bool submag = FALSE;
+  bool bothlogical;
 
   operand = ffeexpr_stack_->exprstack;
   assert (operand != NULL);
@@ -8993,37 +8995,58 @@ ffeexpr_reduce_ (void)
 	  reduced = ffebld_new_and (left_expr, expr);
 	  if (ffe_is_ugly_logint ())
 	    reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
-						 operand);
+						 operand, &bothlogical);
 	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
 					    operand);
 	  reduced = ffeexpr_collapse_and (reduced, operator->token);
+	  if (ffe_is_ugly_logint() && bothlogical)
+	    reduced = ffeexpr_convert (reduced, left_operand->token,
+				       operator->token,
+				       FFEINFO_basictypeLOGICAL,
+				       FFEINFO_kindtypeLOGICALDEFAULT, 0,
+				       FFETARGET_charactersizeNONE,
+				       FFEEXPR_contextLET);
 	  break;
 
 	case FFEEXPR_operatorOR_:
 	  reduced = ffebld_new_or (left_expr, expr);
 	  if (ffe_is_ugly_logint ())
 	    reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
-						 operand);
+						 operand, &bothlogical);
 	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
 					    operand);
 	  reduced = ffeexpr_collapse_or (reduced, operator->token);
+	  if (ffe_is_ugly_logint() && bothlogical)
+	    reduced = ffeexpr_convert (reduced, left_operand->token,
+				       operator->token,
+				       FFEINFO_basictypeLOGICAL,
+				       FFEINFO_kindtypeLOGICALDEFAULT, 0,
+				       FFETARGET_charactersizeNONE,
+				       FFEEXPR_contextLET);
 	  break;
 
 	case FFEEXPR_operatorXOR_:
 	  reduced = ffebld_new_xor (left_expr, expr);
 	  if (ffe_is_ugly_logint ())
 	    reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
-						 operand);
+						 operand, &bothlogical);
 	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
 					    operand);
 	  reduced = ffeexpr_collapse_xor (reduced, operator->token);
+	  if (ffe_is_ugly_logint() && bothlogical)
+	    reduced = ffeexpr_convert (reduced, left_operand->token,
+				       operator->token,
+				       FFEINFO_basictypeLOGICAL,
+				       FFEINFO_kindtypeLOGICALDEFAULT, 0,
+				       FFETARGET_charactersizeNONE,
+				       FFEEXPR_contextLET);
 	  break;
 
 	case FFEEXPR_operatorEQV_:
 	  reduced = ffebld_new_eqv (left_expr, expr);
 	  if (ffe_is_ugly_logint ())
 	    reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
-						 operand);
+						 operand, NULL);
 	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
 					    operand);
 	  reduced = ffeexpr_collapse_eqv (reduced, operator->token);
@@ -9033,7 +9056,7 @@ ffeexpr_reduce_ (void)
 	  reduced = ffebld_new_neqv (left_expr, expr);
 	  if (ffe_is_ugly_logint ())
 	    reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
-						 operand);
+						 operand, NULL);
 	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
 					    operand);
 	  reduced = ffeexpr_collapse_neqv (reduced, operator->token);
@@ -10514,7 +10537,7 @@ ffeexpr_reduced_ugly2_ (ffebld reduced, 
 
 static ffebld
 ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
-			   ffeexprExpr_ r)
+			   ffeexprExpr_ r, bool *bothlogical)
 {
   ffeinfo linfo, rinfo;
   ffeinfoBasictype lbt, rbt;
@@ -10592,6 +10615,32 @@ ffeexpr_reduced_ugly2log_ (ffebld reduce
 	}
       /* else Leave it alone. */
     }
+
+  if (lbt == FFEINFO_basictypeLOGICAL)
+    {
+      ffebld_set_left (reduced,
+		       ffeexpr_convert (ffebld_left (reduced),
+					l->token, op->token,
+					FFEINFO_basictypeINTEGER,
+					FFEINFO_kindtypeINTEGERDEFAULT, 0,
+					FFETARGET_charactersizeNONE,
+					FFEEXPR_contextLET));
+    }
+
+  if (rbt == FFEINFO_basictypeLOGICAL)
+    {
+      ffebld_set_right (reduced,
+			ffeexpr_convert (ffebld_right (reduced),
+					 r->token, op->token,
+					 FFEINFO_basictypeINTEGER,
+					 FFEINFO_kindtypeINTEGERDEFAULT, 0,
+					 FFETARGET_charactersizeNONE,
+					 FFEEXPR_contextLET));
+    }
+
+  if (bothlogical != NULL)
+    *bothlogical = (lbt == FFEINFO_basictypeLOGICAL
+		    && rbt == FFEINFO_basictypeLOGICAL);
 
   return reduced;
 }


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]