[Fortran, Patch] PR33231 - elemental subroutine: intent out needs an array if any actual argument is an array

[Tobias Burnus <burnus at net-b dot de>]

:ADDPATCH fortran:

ELEMENTAL FUNCTIONs require that all variables are INTENT(IN). For
ELEMENTAL SUBROUTINEs, INTENT(OUT) and INTENT(INOUT) is allowed. For
INTENT(IN) scalars and arrays are allowed (the arrays need to be
conformable with another, a scalar is conformable with any arrays).
However, any INTENT(OUT) / INTENT(INOUT) variable must be an array if
any of the actual arguments is an array (see"12.7.3 Elemental subroutine
actual arguments").

This patch adds a check and fixes the example in the test suite.

Build and regression tested on x86_64-unknown-linux-gnu.

OK for the trunk?

Tobias

2007-09-13  Tobias Burnus  <burnus@net-b.de>

	PR fortran/33231
	* resolve.c (resolve_elemental_actual): Check for conformance
	of intent out/inout dummies.

2007-09-13  Tobias Burnus  <burnus@net-b.de>

	PR fortran/33231
	* gfortran.dg/elemental_optional_args_1.f90: Make valid Fortran.
	* gfortran.dg/elemental_subroutine_1.f90: Ditto.
	* gfortran.dg/elemental_subroutine_5.f90: New.

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 128463)
+++ gcc/fortran/resolve.c	(working copy)
@@ -1289,6 +1286,22 @@ resolve_elemental_actual (gfc_expr *expr
 	e = arg->expr;
     }
 
+  /* INTENT(OUT) is only allowed for subroutines; if any actual argument
+     is an array, the intent inout/out variable needs to be also an array.  */
+  if (rank > 0 && esym && expr == NULL)
+    for (eformal = esym->formal, arg = arg0; arg && eformal;
+	 arg = arg->next, eformal = eformal->next)
+      if ((eformal->sym->attr.intent == INTENT_OUT
+	   || eformal->sym->attr.intent == INTENT_INOUT)
+	  && arg->expr && arg->expr->rank == 0)
+	{
+	  gfc_error ("Actual argument at %L for INTENT(%s) dummy '%s' of "
+		     "ELEMENTAL subroutine '%s' is a scalar, but another "
+		     "actual argument is an array", &arg->expr->where,
+		     (eformal->sym->attr.intent == INTENT_OUT) ? "OUT"
+		     : "INOUT", eformal->sym->name, esym->name);
+	  return FAILURE;
+	}
   return SUCCESS;
 }
 
Index: gcc/testsuite/gfortran.dg/elemental_subroutine_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/elemental_subroutine_1.f90	(revision 128463)
+++ gcc/testsuite/gfortran.dg/elemental_subroutine_1.f90	(working copy)
@@ -41,10 +41,12 @@ end module pr22146
   call foobar (u, v)
   if (v.ne.-42.0) call abort ()
 
-  call foobar (x, v)
-  if (v.ne.-2.0) call abort ()
+  v = 2.0
+  call foobar (v, x)
+  if (any(x /= -2.0)) call abort ()
 
 ! Test an expression in the INTENT(IN) argument
+  x = (/1.0, 2.0/)
   call foobar (cos (x) + u, y)
   if (any(abs (y + cos (x) + u) .gt. 2.0e-6)) call abort ()
 
Index: gcc/testsuite/gfortran.dg/elemental_subroutine_5.f90
===================================================================
--- gcc/testsuite/gfortran.dg/elemental_subroutine_5.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/elemental_subroutine_5.f90	(revision 0)
@@ -0,0 +1,27 @@
+! { dg-do compile }
+!
+! PR fortran/33231
+!
+! Elemental function:
+! Intent OUT/INOUT dummy: Actual needs to be an array
+! if any actual is an array
+!
+program prog
+implicit none
+integer :: i, j(2)
+call sub(i,1,2) ! OK, only scalar
+call sub(j,1,2) ! OK, scalar IN, array OUT
+call sub(j,[1,2],3) ! OK, scalar & array IN, array OUT
+call sub(j,[1,2],[1,2]) ! OK, all arrays
+
+call sub(i,1,2) ! OK, only scalar
+call sub(i,[1,2],3) ! { dg-error "is a scalar" }
+call sub(i,[1,2],[1,2]) ! { dg-error "is a scalar" }
+contains
+elemental subroutine sub(a,b,c)
+  integer :: func, a, b, c
+  intent(in) :: b,c
+  intent(out) :: a
+  a = b +c
+end subroutine sub
+end program prog
Index: gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90	(revision 128463)
+++ gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90	(working copy)
@@ -11,7 +11,7 @@
   CALL T1(1,2)
 CONTAINS
   SUBROUTINE T1(A1,A2,A3)
-    INTEGER           :: A1,A2, A4(2)
+    INTEGER           :: A1,A2, A4(2), A5(2)
     INTEGER, OPTIONAL :: A3(2)
     interface
       elemental function efoo (B1,B2,B3) result(bar)
@@ -34,9 +34,9 @@ CONTAINS
     write(6,*) efoo(A1,A3,A2)
     write(6,*) efoo(A1,A4,A3)
 ! check an elemental subroutine
-    call foobar (A1,A2,A3) ! { dg-warning "array and OPTIONAL" } 
-    call foobar (A1,A2,A4)
-    call foobar (A1,A4,A4)
+    call foobar (A5,A2,A3) ! { dg-warning "array and OPTIONAL" } 
+    call foobar (A5,A2,A4)
+    call foobar (A5,A4,A4)
   END SUBROUTINE
   elemental function foo (B1,B2,B3) result(bar)
     INTEGER, intent(in)           :: B1, B2