From 685d8dafb4a1cb29ee219ad7857614ff66a78022 Mon Sep 17 00:00:00 2001 From: Mark Eggleston 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-07-01 Steven G. Kargl 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 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 4a2abd0..2a16405 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 c19c1df..56a9db5 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 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 + +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.7.4