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-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.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4a2abd00f4afbaa65ed5584f80cb69be731440e1..2a164055ffcd8a56e8184fe0656a59257e7cf6cb 100644 (file)
--- 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 c19c1df3e2b0e3642502d73ce987b4e427817994..56a9db56be27ae1a29c662983d1ccc10e0725baa 100644 (file)
--- 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 (file)
index 0000000..86e1019
--- /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.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
+