OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Fortran : False positive for optional arguments PR95446

Browse Source 
Check that there is non-optional argument of the same rank in the
list of actual arguments.  If there is the warning is not required.

2020-07-01  Steven G. Kargl  <kargl@gcc.gnu.org>

gcc/fortran/

	PR fortran/95446
	* resolve.c (resolve_elemental_actual): Add code to check for
	non-optional argument of the same rank.  Revise warning message
	to refer to the Fortran 2018 standard.

2020-07-01  Mark Eggleston  <markeggleston@gcc.gnu.org>

gcc/testsuite/

	PR fortran/95446
	* gfortran.dg/elemental_optional_args_6.f90: Remove check
	for warnings that were erroneously output.
	* gfortran.dg/pr95446.f90: New test.
This commit is contained in:
Mark Eggleston 2020-06-01 14:56:00 +01:00
parent 8461191b82
commit 685d8dafb4
3 changed files with 62 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
gcc/fortran/resolve.c
View File

@ -2277,12 +2277,28 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
&& (set_by_optional || arg->expr->rank != rank)
&& !(isym && isym->id == GFC_ISYM_CONVERSION))
{
gfc_warning (OPT_Wpedantic,
"%qs at %L is an array and OPTIONAL; IF IT IS "
"MISSING, it cannot be the actual argument of an "
"ELEMENTAL procedure unless there is a non-optional "
"argument with the same rank (12.4.1.5)",
arg->expr->symtree->n.sym->name, &arg->expr->where);
bool t = false;
gfc_actual_arglist *a;
/* Scan the argument list for a non-optional argument with the
same rank as arg. */
for (a = arg0; a; a = a->next)
if (a != arg
&& a->expr->rank == arg->expr->rank
&& !a->expr->symtree->n.sym->attr.optional)
{
t = true;
break;
}
if (!t)
gfc_warning (OPT_Wpedantic,
"%qs at %L is an array and OPTIONAL; If it is not "
"present, then it cannot be the actual argument of "
"an ELEMENTAL procedure unless there is a non-optional"
" argument with the same rank "
"(Fortran 2018, 15.5.2.12)",
arg->expr->symtree->n.sym->name, &arg->expr->where);
}
}

4
gcc/testsuite/gfortran.dg/elemental_optional_args_6.f90
View File

@ -21,8 +21,8 @@ contains
integer, optional :: arg1(:)
integer :: arg2(:)
! print *, fun1 (arg1, arg2)
if (size (fun1 (arg1, arg2)) /= 2) STOP 1 ! { dg-warning "is an array and OPTIONAL" }
if (any (fun1 (arg1, arg2) /= [1,2])) STOP 2 ! { dg-warning "is an array and OPTIONAL" }
if (size (fun1 (arg1, arg2)) /= 2) STOP 1
if (any (fun1 (arg1, arg2) /= [1,2])) STOP 2
end subroutine
elemental function fun1 (arg1, arg2)

38
gcc/testsuite/gfortran.dg/pr95446.f90 Normal file
View File

@ -0,0 +1,38 @@
! { dg-do compile }
! { dg-options "-pedantic-errors" }
!
! Contributed by Martin Diehl <m.diehl@mpie.de>
program elemental_optional
implicit none
integer :: m(5), r(5)
m = 1
r = outer()
r = outer(m)
contains
function outer(o) result(l)
integer, intent(in), optional :: o(:)
integer :: u(5), l(5)
l = inner(o,u)
end function outer
elemental function inner(a,b) result(x)
integer, intent(in), optional :: a
integer, intent(in) :: b
integer :: x
if(present(a)) then
x = a*b
else
x = b
endif
end function inner
end program elemental_optional