[Fortran, patch] PR32323 - give error for vector subscript actual arguments to intent out/inout

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

:ADDPATCH fortran:

"12.4.1.2 Actual arguments associated with dummy data objects"
"If a nonpointer dummy argument has INTENT (OUT) or INTENT (INOUT), the actual
argument shall be definable."
"If the actual argument is an array section having a vector subscript, the
dummy argument is not definable and shall not have the INTENT (OUT), INTENT
(INOUT), VOLATILE, or ASYNCHRONOUS attributes."


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

Ok for the trunk?
(Anyone wants to see this for the branch? I don't.)


Tobias

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

	PR fortran/32323
	* interface.c (has_vector_section): New.
	 (compare_actual_formal): Check for array sections with vector subscript.

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

	PR fortran/32323
	* gfortran.dg/actual_array_vect_1.f90: New.

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(Revision 125681)
+++ gcc/fortran/interface.c	(Arbeitskopie)
@@ -1261,6 +1261,29 @@ compare_parameter_protected (gfc_symbol 
 }
 
 
+/* Given an expression, check whether it is an array section
+   which has a vector subscript. If it has, one is returned,
+   otherwise zero.  */
+
+static int
+has_vector_section (gfc_expr *e)
+{
+  int i;
+  gfc_ref *ref;
+
+  if (e == NULL || e->rank == 0 || e->expr_type != EXPR_VARIABLE)
+    return 0;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
+      for (i = 0; i < ref->u.ar.dimen; i++)
+	if (ref->u.ar.dimen_type[i] == DIMEN_VECTOR)
+	  return 1;
+
+  return 0;
+}
+
+
 /* Given formal and actual argument lists, see if they are compatible.
    If they are compatible, the actual argument list is sorted to
    correspond with the formal list, and elements for missing optional
@@ -1471,6 +1494,19 @@ compare_actual_formal (gfc_actual_arglis
 	  return 0;
 	}
 
+      if ((f->sym->attr.intent == INTENT_OUT
+	   || f->sym->attr.intent == INTENT_INOUT
+	   || f->sym->attr.volatile_)
+          && has_vector_section(a->expr))
+	{
+	  if (where)
+	    gfc_error ("Array-section actual argument with vector subscripts "
+		       "at %L is incompatible with INTENT(IN), INTENT(INOUT) "
+		       "or VOLATILE attribute of the dummy argument '%s'",
+		       &a->expr->where, f->sym->name);
+	  return 0;
+	}
+
       /* C1232 (R1221) For an actual argument which is an array section or
 	 an assumed-shape array, the dummy argument shall be an assumed-
 	 shape array, if the dummy argument has the VOLATILE attribute.  */
Index: gcc/testsuite/gfortran.dg/actual_array_vect_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/actual_array_vect_1.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/actual_array_vect_1.f90	(Revision 0)
@@ -0,0 +1,33 @@
+! { dg-do compile }
+! PR fortran/32323
+! Array sections with vector subscripts are not allowed
+! with dummy arguments which have VOLATILE or INTENT OUT/INOUT
+!
+! Contributed by terry@chem.gu.se
+!
+module mod
+implicit none
+contains
+subroutine aa(v)
+integer,dimension(:),volatile::v
+write(*,*)size(v)
+v=0
+end subroutine aa
+subroutine bb(v)
+integer,dimension(:),intent(out)::v
+write(*,*)size(v)
+v=0
+end subroutine bb
+end module mod
+
+program ff
+use mod
+implicit none
+integer,dimension(10)::w
+w=1
+call aa(w(2:4))
+call aa(w((/3,2,1/))) ! { dg-error "vector subscript" }
+call bb(w(2:4))
+call bb(w((/3,2,1/))) ! { dg-error "vector subscript" }
+write(*,*)w
+end