re PR fortran/38487 (Bogus Warning: INTENT(INOUT) actual argument might interfere with actual argument)

2008-12-15  Mikael Morin  <mikael.morin@tele2.fr>

	PR fortran/38487
	* gfortran.dg/elemental_dependency_2.f90: New test.

2008-12-15  Mikael Morin  <mikael.morin@tele2.fr>

	PR fortran/38487
	* dependency.c (gfc_is_data_pointer): New function.
	(gfc_check_argument_var_dependency): Disable the warning
	in the pointer case.
	(gfc_check_dependency): Use gfc_is_data_pointer.

From-SVN: r142766
This commit is contained in:
Mikael Morin 2008-12-15 19:08:42 +01:00 committed by Mikael Morin
parent 5c08ab4eae
commit ea4547bbfa
4 changed files with 71 additions and 12 deletions

View file

@ -1,3 +1,11 @@
2008-12-15 Mikael Morin <mikael.morin@tele2.fr>
PR fortran/38487
* dependency.c (gfc_is_data_pointer): New function.
(gfc_check_argument_var_dependency): Disable the warning
in the pointer case.
(gfc_check_dependency): Use gfc_is_data_pointer.
2008-12-15 Mikael Morin <mikael.morin@tele2.fr> 2008-12-15 Mikael Morin <mikael.morin@tele2.fr>
PR fortran/38113 PR fortran/38113

View file

@ -422,6 +422,24 @@ gfc_ref_needs_temporary_p (gfc_ref *ref)
} }
static int
gfc_is_data_pointer (gfc_expr *e)
{
gfc_ref *ref;
if (e->expr_type != EXPR_VARIABLE)
return 0;
if (e->symtree->n.sym->attr.pointer)
return 1;
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
return 1;
return 0;
}
/* Return true if array variable VAR could be passed to the same function /* Return true if array variable VAR could be passed to the same function
as argument EXPR without interfering with EXPR. INTENT is the intent as argument EXPR without interfering with EXPR. INTENT is the intent
of VAR. of VAR.
@ -447,7 +465,9 @@ gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
if (gfc_ref_needs_temporary_p (expr->ref) if (gfc_ref_needs_temporary_p (expr->ref)
|| gfc_check_dependency (var, expr, !elemental)) || gfc_check_dependency (var, expr, !elemental))
{ {
if (elemental == ELEM_DONT_CHECK_VARIABLE) if (elemental == ELEM_DONT_CHECK_VARIABLE
&& !gfc_is_data_pointer (var)
&& !gfc_is_data_pointer (expr))
{ {
/* Elemental procedures forbid unspecified intents, /* Elemental procedures forbid unspecified intents,
and we don't check dependencies for INTENT_IN args. */ and we don't check dependencies for INTENT_IN args. */
@ -664,7 +684,6 @@ gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
{ {
gfc_actual_arglist *actual; gfc_actual_arglist *actual;
gfc_constructor *c; gfc_constructor *c;
gfc_ref *ref;
int n; int n;
gcc_assert (expr1->expr_type == EXPR_VARIABLE); gcc_assert (expr1->expr_type == EXPR_VARIABLE);
@ -700,17 +719,8 @@ gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
/* If either variable is a pointer, assume the worst. */ /* If either variable is a pointer, assume the worst. */
/* TODO: -fassume-no-pointer-aliasing */ /* TODO: -fassume-no-pointer-aliasing */
if (expr1->symtree->n.sym->attr.pointer) if (gfc_is_data_pointer (expr1) || gfc_is_data_pointer (expr2))
return 1; return 1;
for (ref = expr1->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
return 1;
if (expr2->symtree->n.sym->attr.pointer)
return 1;
for (ref = expr2->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
return 1;
/* Otherwise distinct symbols have no dependencies. */ /* Otherwise distinct symbols have no dependencies. */
return 0; return 0;

View file

@ -1,3 +1,8 @@
2008-12-15 Mikael Morin <mikael.morin@tele2.fr>
PR fortran/38487
* gfortran.dg/elemental_dependency_2.f90: New test.
2008-12-14 Paul Thomas <pault@gcc.gnu.org> 2008-12-14 Paul Thomas <pault@gcc.gnu.org>
PR fortran/35937 PR fortran/35937

View file

@ -0,0 +1,36 @@
! { dg-do compile }
!
! PR fortran/38487
! Spurious warning on pointers as elemental subroutine actual arguments
!
! Contributed by Harald Anlauf <anlauf@gmx.de>
module gfcbug82
implicit none
type t
real, pointer :: q(:) =>NULL()
real, pointer :: r(:) =>NULL()
end type t
type (t), save :: x, y
real, dimension(:), pointer, save :: a => NULL(), b => NULL()
real, save :: c(5), d
contains
elemental subroutine add (q, r)
real, intent (inout) :: q
real, intent (in) :: r
q = q + r
end subroutine add
subroutine foo ()
call add (y% q, x% r)
call add (y% q, b )
call add (a , x% r)
call add (a , b )
call add (y% q, d )
call add (a , d )
call add (c , x% r)
call add (c , b )
end subroutine foo
end module gfcbug82
! { dg-final { cleanup-modules "gfcbug82" } }