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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 24ba2ecf16ebcd033944b43cf4cc5355fbd6da76..ad04007c119f9e5d263ca8902371c3353a6219c0 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 40c476a56f0e5ca4fb13a24bea78761b18db858e..5d1c1160de26f504f03e2c29a481b875c00e108c 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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;
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 86d1b8e19700032c3d2895d2214c66ffebc863b6..a07270af87de748b69ecc8015eabe689fd4db352 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,10 @@
+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

diff --git a/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90 b/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90
index 4f274baa20bf3ad4b4e1c1836cbc446bc90be7d2..aed6cadc350d1938d6f4732a8ccfa60108b8ad2b 100644 (file)
--- a/gcc/testsuite/gfortran.dg/elemental_optional_args_1.f90
+++ b/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

diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_1.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_1.f90
index 85ba3f9e73e6cbd8325e645d9e28d72de8b19cdb..298b54eee3d41b21cb8fc89aeed9413571fcaf2d 100644 (file)
--- a/gcc/testsuite/gfortran.dg/elemental_subroutine_1.f90
+++ b/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 ()
 

diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_5.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_5.f90
new file mode 100644 (file)
index 0000000..efadb6d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_5.f90
@@ -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