+2009-12-14 Sebastian Pop <sebastian.pop@amd.com>
+
+ PR middle-end/42181
+ * graphite-scop-detection.c (graphite_can_represent_scev): Handle more
+ carefully PLUS_EXPR, MINUS_EXPR, and MULT_EXPR.
+
+ * testsuite/gfortran.dg/graphite/pr42181.f90: New.
+
2009-12-12 Sebastian Pop <sebpop@gmail.com>
PR middle-end/42284
if (chrec_contains_undetermined (scev))
return false;
- if (TREE_CODE (scev) == POLYNOMIAL_CHREC
+ switch (TREE_CODE (scev))
+ {
+ case PLUS_EXPR:
+ case MINUS_EXPR:
+ return graphite_can_represent_scev (TREE_OPERAND (scev, 0), outermost_loop)
+ && graphite_can_represent_scev (TREE_OPERAND (scev, 1), outermost_loop);
+
+ case MULT_EXPR:
+ return !CONVERT_EXPR_CODE_P (TREE_CODE (TREE_OPERAND (scev, 0)))
+ && !CONVERT_EXPR_CODE_P (TREE_CODE (TREE_OPERAND (scev, 1)))
+ && !(chrec_contains_symbols (TREE_OPERAND (scev, 0))
+ && chrec_contains_symbols (TREE_OPERAND (scev, 1)))
+ && graphite_can_represent_scev (TREE_OPERAND (scev, 0), outermost_loop)
+ && graphite_can_represent_scev (TREE_OPERAND (scev, 1), outermost_loop);
+ case POLYNOMIAL_CHREC:
/* Check for constant strides. With a non constant stride of
- 'n' we would have a value of 'iv * n'. */
- && (!evolution_function_right_is_integer_cst (scev)
+ 'n' we would have a value of 'iv * n'. Also check that the
+ initial value can represented: for example 'n * m' cannot be
+ represented. */
+ if (!evolution_function_right_is_integer_cst (scev)
+ || !graphite_can_represent_init (scev))
+ return false;
- /* Check the initial value: 'n * m' cannot be represented. */
- || !graphite_can_represent_init (scev)))
- return false;
+ default:
+ break;
+ }
/* Only affine functions can be represented. */
if (!scev_is_linear_expression (scev))
--- /dev/null
+! { dg-options "-O1 -fgraphite" }
+
+MODULE powell
+ INTEGER, PARAMETER :: dp=8
+CONTAINS
+ SUBROUTINE newuob (n,npt,x,rhobeg,rhoend,maxfun,xbase,&
+ xopt,xnew,xpt,fval,gq,hq,pq,bmat,zmat,ndim,d,vlag,w,opt)
+ REAL(dp), DIMENSION(npt, *), &
+ INTENT(inout) :: xpt
+ REAL(dp), DIMENSION(*), INTENT(inout) :: fval, gq, hq, pq
+120 IF (dsq <= 1.0e-3_dp*xoptsq) THEN
+ DO k=1,npt
+ DO i=1,n
+ gq(i)=gq(i)+temp*xpt(k,i)
+ END DO
+ END DO
+ END IF
+ END SUBROUTINE newuob
+END MODULE powell