re PR fortran/33231 (Reject for -std=f* calls to elementar functions where array…

re PR fortran/33231 (Reject for -std=f* calls to elementar functions where array and scalar are mixed)

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

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

2007-09-18  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.

From-SVN: r128570

gcc/fortran/ChangeLog

+2007-09-18  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/33231
+	* resolve.c (resolve_elemental_actual): Check for conformance
+	of intent out/inout dummies.
+
 2007-09-17  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/33106

gcc/fortran/resolve.c

@@ -1286,6 +1286,22 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c)
 	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;
 }
 

gcc/testsuite/ChangeLog

+2007-09-18  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.
+
 2007-09-18  Richard Sandiford  <rsandifo@nildram.co.uk>
 
 	* lib/target-supports.exp (check_profiling_available): Extend

gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90

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

gcc/testsuite/gfortran.dg/elemental_subroutine_1.f90

@@ -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 ()
 

gcc/testsuite/gfortran.dg/elemental_subroutine_5.f90

+! { 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