dependency.c (gfc_dep_compare_expr): Allow unary and binary operators to compare equal if their operands are equal.

* dependency.c (gfc_dep_compare_expr) <EXPR_OP>: Allow unary and
	binary operators to compare equal if their operands are equal.
	<EXPR_FUNCTION>: Allow "constant" intrinsic conversion functions
	to compare equal, if their operands are equal.

	* gfortran.dg/dependency_10.f90: New test case.
	* gfortran.dg/dependency_11.f90: Likewise.

From-SVN: r111970
This commit is contained in:
Roger Sayle 2006-03-11 22:25:58 +00:00
parent fc6c490eea
commit 37ad72f254
5 changed files with 99 additions and 10 deletions

View file

@ -1,20 +1,27 @@
2003-03-11 Roger Sayle <roger@eyesopen.com>
* dependency.c (gfc_dep_compare_expr) <EXPR_OP>: Allow unary and
binary operators to compare equal if their operands are equal.
<EXPR_FUNCTION>: Allow "constant" intrinsic conversion functions
to compare equal, if their operands are equal.
2006-03-11 Erik Edelmann <eedelman@gcc.gnu.org>
* symbol.c (check_conflict): Allow allocatable function results,
except for elemental functions.
except for elemental functions.
* trans-array.c (gfc_trans_allocate_temp_array): Rename to ...
(gfc_trans_create_temp_array): ... this, and add new argument
callee_alloc.
(gfc_trans_array_constructor, gfc_conv_loop_setup): Update call
to gfc_trans_allocate_temp_array.
(gfc_trans_create_temp_array): ... this, and add new argument
callee_alloc.
(gfc_trans_array_constructor, gfc_conv_loop_setup): Update call
to gfc_trans_allocate_temp_array.
* trans-array.h (gfc_trans_allocate_temp_array): Update prototype.
* trans-expr.c (gfc_conv_function_call): Use new arg of
gfc_trans_create_temp_array avoid pre-allocation of temporary
result variables of pointer AND allocatable functions.
(gfc_trans_arrayfunc_assign): Return NULL for allocatable
functions.
gfc_trans_create_temp_array avoid pre-allocation of temporary
result variables of pointer AND allocatable functions.
(gfc_trans_arrayfunc_assign): Return NULL for allocatable
functions.
* resolve.c (resolve_symbol): Copy value of 'allocatable' attribute
from sym->result to sym.
from sym->result to sym.
2006-03-09 Erik Edelmann <eedelman@gcc.gnu.org>

View file

@ -97,6 +97,57 @@ gfc_dep_compare_expr (gfc_expr * e1, gfc_expr * e2)
return 0;
return -2;
case EXPR_OP:
/* Intrinsic operators are the same if their operands are the same. */
if (e1->value.op.operator != e2->value.op.operator)
return -2;
if (e1->value.op.op2 == 0)
{
i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
return i == 0 ? 0 : -2;
}
if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0
&& gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0)
return 0;
/* TODO Handle commutative binary operators here? */
return -2;
case EXPR_FUNCTION:
/* We can only compare calls to the same intrinsic function. */
if (e1->value.function.isym == 0
|| e2->value.function.isym == 0
|| e1->value.function.isym != e2->value.function.isym)
return -2;
/* We should list the "constant" intrinsic functions. Those
without side-effects that provide equal results given equal
argument lists. */
switch (e1->value.function.isym->generic_id)
{
case GFC_ISYM_CONVERSION:
case GFC_ISYM_REAL:
case GFC_ISYM_LOGICAL:
case GFC_ISYM_DBLE:
break;
default:
return -2;
}
/* Compare the argument lists for equality. */
{
gfc_actual_arglist *args1 = e1->value.function.actual;
gfc_actual_arglist *args2 = e2->value.function.actual;
while (args1 && args2)
{
if (gfc_dep_compare_expr (args1->expr, args2->expr) != 0)
return -2;
args1 = args1->next;
args2 = args2->next;
}
return (args1 || args2) ? -2 : 0;
}
default:
return -2;
}

View file

@ -1,3 +1,8 @@
2003-03-11 Roger Sayle <roger@eyesopen.com>
* gfortran.dg/dependency_10.f90: New test case.
* gfortran.dg/dependency_11.f90: Likewise.
2006-03-11 Paul Thomas <pault@gcc.gnu.org>
Erik Edelmann <eedelman@gcc.gnu.org>

View file

@ -0,0 +1,13 @@
! { dg-do compile }
! { dg-options "-O2 -fdump-tree-original" }
subroutine foo(a)
integer, dimension (4) :: a
integer :: n
n = 3
where (a(:n) .ne. 0)
a(:n) = 1
endwhere
end subroutine
! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

View file

@ -0,0 +1,13 @@
! { dg-do compile }
! { dg-options "-O2 -fdump-tree-original" }
subroutine foo(a)
integer, dimension (4) :: a
integer :: n
n = 3
where (a(:n-1) .ne. 0)
a(:n-1) = 1
endwhere
end subroutine
! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }