Please find attached a fix for PR95446. Patch originally posted to the
PR by Steve Kargl.
OK to commit to master and backport?
Commit message:
Fortran : False positive for optional arguments PR95446
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-06-24 Steven G. Kargl <ka...@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-06-24 Mark Eggleston <markeggles...@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.
--
https://www.codethink.co.uk/privacy.html
>From 4ad64b418c93064cfdfd07fc8a9e6305d8cc68db Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggles...@gcc.gnu.org>
Date: Mon, 1 Jun 2020 14:56:00 +0100
Subject: [PATCH] Fortran : False positive for optional arguments PR95446
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-06-24 Steven G. Kargl <ka...@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-06-24 Mark Eggleston <markeggles...@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.
---
gcc/fortran/resolve.c | 28 ++++++++++++----
.../gfortran.dg/elemental_optional_args_6.f90 | 4 +--
gcc/testsuite/gfortran.dg/pr95446.f90 | 38 ++++++++++++++++++++++
3 files changed, 62 insertions(+), 8 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/pr95446.f90
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index aaee5eb6b9b..842fefcb4cd 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -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);
}
}
diff --git a/gcc/testsuite/gfortran.dg/elemental_optional_args_6.f90 b/gcc/testsuite/gfortran.dg/elemental_optional_args_6.f90
index c19c1df3e2b..56a9db56be2 100644
--- a/gcc/testsuite/gfortran.dg/elemental_optional_args_6.f90
+++ b/gcc/testsuite/gfortran.dg/elemental_optional_args_6.f90
@@ -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)
diff --git a/gcc/testsuite/gfortran.dg/pr95446.f90 b/gcc/testsuite/gfortran.dg/pr95446.f90
new file mode 100644
index 00000000000..86e1019d7af
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr95446.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! { dg-options "-pedantic-errors" }
+!
+! Contributed by Martin Diehl <m.di...@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
+
--
2.11.0
