Fortran : False positive for optional arguments PR95446

Message ID 5de37f15-61d5-e3b6-1fd5-1d97e2f04376@codethink.co.uk
State New
Headers show
Series
  • Fortran : False positive for optional arguments PR95446
Related show

Commit Message

Mark Eggleston June 24, 2020, 8 a.m.
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  <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-06-24  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.


-- 
https://www.codethink.co.uk/privacy.html

Comments

Mark Eggleston June 30, 2020, 12:58 p.m. | #1
ping!

On 24/06/2020 09:00, Mark Eggleston wrote:
> 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  <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-06-24  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.

>

>

-- 
https://www.codethink.co.uk/privacy.html
Thomas Koenig June 30, 2020, 1:09 p.m. | #2
Hi Mark,

this is OK.

Regarding backport: This is not a regression, and the patch itself
is a bit large to bee entirely trivial.  So, I'd prefer it you left
that for master.

Thanks for taking this up!

Regards

	Thomas

Patch

From 4ad64b418c93064cfdfd07fc8a9e6305d8cc68db Mon Sep 17 00:00:00 2001
From: Mark Eggleston <markeggleston@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  <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-06-24  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.
---
 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.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
+
-- 
2.11.0