[PATCH] Fix PR39937, wrong types from distribute_real_division

[Richard Guenther]

On Tue, 28 Apr 2009, Richard Guenther wrote:

> 
> 416.gamess fails to build because distribute_real_division
> looses sign-changes.  The fix is to only use distribute_real_division
> on floating point types.  I verified the corresponding (but correct)
> transformation is done for integers elsewhere.
> 
> Bootstrap / regtest ongoing on x86_64-unknown-linux-gnu, I'll apply
> this after it succeeded.

Too much quick cut&pasting.  The following is better.

Richard.

2009-04-28  Richard Guenther  <rguenther@suse.de>

	PR middle-end/39937
	* fold-const.c (fold_binary): Use distribute_real_division only
	on float types.

	* gfortran.fortran-torture/compile/pr39937.f: New testcase.

Index: gcc/testsuite/gfortran.fortran-torture/compile/pr39937.f
===================================================================
*** gcc/testsuite/gfortran.fortran-torture/compile/pr39937.f	(revision 0)
--- gcc/testsuite/gfortran.fortran-torture/compile/pr39937.f	(revision 0)
***************
*** 0 ****
--- 1,28 ----
+       SUBROUTINE DTREVC( SIDE, HOWMNY, SELECT, N, T, LDT, VL, LDVL, VR,
+      $                   LDVR, MM, M, WORK, INFO )
+       DOUBLE PRECISION   T( LDT, * ), VL( LDVL, * ), VR( LDVR, * ),
+      $                   WORK( * )
+       DOUBLE PRECISION   X( 2, 2 )
+       CALL DLALN2( .FALSE., 1, 1, SMIN, ONE, T( J, J ),
+      $                            ZERO, X, 2, SCALE, XNORM, IERR )
+       CALL DSCAL( KI, SCALE, WORK( 1+N ), 1 )
+       DO 90 J = KI - 2, 1, -1
+       IF( J.GT.JNXT )
+      $               GO TO 90
+       JNXT = J - 1
+       IF( J.GT.1 ) THEN
+           IF( T( J, J-1 ).NE.ZERO ) THEN
+               IF( WORK( J ).GT.BIGNUM / XNORM ) THEN
+                   X( 1, 1 ) = X( 1, 1 ) / XNORM
+               END IF
+           END IF
+           CALL DLALN2( .FALSE., 2, 2, SMIN, ONE,
+      $                            T( J-1, J-1 ), LDT, ONE, ONE,
+      $                            XNORM, IERR )
+           CALL DAXPY( J-2, -X( 1, 1 ), T( 1, J-1 ), 1,
+      $                           WORK( 1+N ), 1 )
+           CALL DAXPY( J-2, -X( 2, 2 ), T( 1, J ), 1,
+      $                           WORK( 1+N2 ), 1 )
+       END IF
+    90          CONTINUE
+       END
Index: gcc/fold-const.c
===================================================================
*** gcc/fold-const.c	(revision 146887)
--- gcc/fold-const.c	(working copy)
*************** fold_binary (enum tree_code code, tree t
*** 10102,10108 ****
  		}
  	    }
  
!           if (flag_unsafe_math_optimizations
  	      && (TREE_CODE (arg0) == RDIV_EXPR || TREE_CODE (arg0) == MULT_EXPR)
  	      && (TREE_CODE (arg1) == RDIV_EXPR || TREE_CODE (arg1) == MULT_EXPR)
  	      && (tem = distribute_real_division (code, type, arg0, arg1)))
--- 10102,10108 ----
  		}
  	    }
  
! 	  if (flag_unsafe_math_optimizations
  	      && (TREE_CODE (arg0) == RDIV_EXPR || TREE_CODE (arg0) == MULT_EXPR)
  	      && (TREE_CODE (arg1) == RDIV_EXPR || TREE_CODE (arg1) == MULT_EXPR)
  	      && (tem = distribute_real_division (code, type, arg0, arg1)))
*************** fold_binary (enum tree_code code, tree t
*** 10542,10548 ****
  	    }
  	}
  
!       if (flag_unsafe_math_optimizations
  	  && (TREE_CODE (arg0) == RDIV_EXPR || TREE_CODE (arg0) == MULT_EXPR)
  	  && (TREE_CODE (arg1) == RDIV_EXPR || TREE_CODE (arg1) == MULT_EXPR)
  	  && (tem = distribute_real_division (code, type, arg0, arg1)))
--- 10542,10549 ----
  	    }
  	}
  
!       if (FLOAT_TYPE_P (type)
! 	  && flag_unsafe_math_optimizations
  	  && (TREE_CODE (arg0) == RDIV_EXPR || TREE_CODE (arg0) == MULT_EXPR)
  	  && (TREE_CODE (arg1) == RDIV_EXPR || TREE_CODE (arg1) == MULT_EXPR)
  	  && (tem = distribute_real_division (code, type, arg0, arg1)))