re PR fortran/32323 (Accepts invalid vector subscript actual argument for intent...

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.

From-SVN: r125684

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c6397e4ba052718f240921c96cb9232ebf184f83..43fcc43e053e2c99feed3e28f52b514d0f29319c 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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-12  Dirk Mueller  <dmueller@suse.de>
 
        * trans-stmt.c (gfc_trans_call): fix gcc_assert to

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index c30b4d68b2defe02095e5b80abb46a309824e663..591e46e0af2209afa6aece9c9ed2b499e494425f 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1261,6 +1261,29 @@ compare_parameter_protected (gfc_symbol *formal, gfc_expr *actual)
 }
 
 
+/* 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_subscript (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_arglist **ap, gfc_formal_arglist *formal,
          return 0;
        }
 
+      if ((f->sym->attr.intent == INTENT_OUT
+          || f->sym->attr.intent == INTENT_INOUT
+          || f->sym->attr.volatile_)
+          && has_vector_subscript (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.  */

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a0d61bef205a73a616003b1508b127dcd05f1ce9..a0c242b403e30208d0e9f61c66b6b091bf2fcea3 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-06-13  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/32323
+       * gfortran.dg/actual_array_vect_1.f90: New.
+
 2007-06-13  Eric Botcazou  <ebotcazou@libertysurf.fr>
 
        * gcc.target/sparc/mfpu.c: New test.
@@ -61,8 +66,8 @@
 
 2007-06-11  Paolo Bonzini  <bonzini@gnu.org>
 
-        PR rtl-optimization/31025
-        * gfortran.dg/pr31025.f90: New.
+       PR rtl-optimization/31025
+       * gfortran.dg/pr31025.f90: New.
 
 2007-06-11  Uros Bizjak  <ubizjak@gmail.com>
 
@@ -335,53 +340,53 @@
        * g++.dg/ext/is_pod_incomplete.C: New.
 
 2007-05-31  Russell Yanofsky <russ@yanofsky.org>
-            Douglas Gregor <doug.gregor@gmail.com>
-            Pedro Lamarao <pedro.lamarao@mndfck.org>
-            Howard Hinnant <howard.hinnant@gmail.com>
+           Douglas Gregor <doug.gregor@gmail.com>
+           Pedro Lamarao <pedro.lamarao@mndfck.org>
+           Howard Hinnant <howard.hinnant@gmail.com>
 
        PR c++/7412
        PR c++/29939
-        * g++.dg/cpp0x/rv8p.C: New.
-        * g++.dg/cpp0x/temp-constructor-bug.C: New.
-        * g++.dg/cpp0x/cast-bug.C: New.
-        * g++.dg/cpp0x/elision_weak.C: New.
-        * g++.dg/cpp0x/collapse-bug.C: New.
-        * g++.dg/cpp0x/rv3p.C: New.
-        * g++.dg/cpp0x/rv7n.C: New.
-        * g++.dg/cpp0x/overload-conv-1.C: New.
-        * g++.dg/cpp0x/rv2n.C: New.
-        * g++.dg/cpp0x/deduce.C: New.
-        * g++.dg/cpp0x/temp-va-arg-bug.C: New.
-        * g++.dg/cpp0x/rv6p.C: New.
-        * g++.dg/cpp0x/template_deduction.C: New.
-        * g++.dg/cpp0x/implicit-copy.C: New.
-        * g++.dg/cpp0x/rv1p.C: New.
-        * g++.dg/cpp0x/cast.C: New.
-        * g++.dg/cpp0x/rv5n.C: New.
-        * g++.dg/cpp0x/collapse.C: New.
-        * g++.dg/cpp0x/overload-conv-2.C: New.
-        * g++.dg/cpp0x/rv4p.C: New.
+       * g++.dg/cpp0x/rv8p.C: New.
+       * g++.dg/cpp0x/temp-constructor-bug.C: New.
+       * g++.dg/cpp0x/cast-bug.C: New.
+       * g++.dg/cpp0x/elision_weak.C: New.
+       * g++.dg/cpp0x/collapse-bug.C: New.
+       * g++.dg/cpp0x/rv3p.C: New.
+       * g++.dg/cpp0x/rv7n.C: New.
+       * g++.dg/cpp0x/overload-conv-1.C: New.
+       * g++.dg/cpp0x/rv2n.C: New.
+       * g++.dg/cpp0x/deduce.C: New.
+       * g++.dg/cpp0x/temp-va-arg-bug.C: New.
+       * g++.dg/cpp0x/rv6p.C: New.
+       * g++.dg/cpp0x/template_deduction.C: New.
+       * g++.dg/cpp0x/implicit-copy.C: New.
+       * g++.dg/cpp0x/rv1p.C: New.
+       * g++.dg/cpp0x/cast.C: New.
+       * g++.dg/cpp0x/rv5n.C: New.
+       * g++.dg/cpp0x/collapse.C: New.
+       * g++.dg/cpp0x/overload-conv-2.C: New.
+       * g++.dg/cpp0x/rv4p.C: New.
        * g++.dg/cpp0x/rvo.C: New.
-        * g++.dg/cpp0x/iop.C: New.
-        * g++.dg/cpp0x/rv3n.C: New.
-        * g++.dg/cpp0x/rv7p.C: New.
-        * g++.dg/cpp0x/reference_collapsing.C: New.
-        * g++.dg/cpp0x/overload.C: New.
-        * g++.dg/cpp0x/named.C: New.
-        * g++.dg/cpp0x/rv2p.C: New.
-        * g++.dg/cpp0x/rv6n.C: New.
-        * g++.dg/cpp0x/not_special.C: New.
-        * g++.dg/cpp0x/bind.C: New.
-        * g++.dg/cpp0x/rv1n.C: New.
-        * g++.dg/cpp0x/rv5p.C: New.
-        * g++.dg/cpp0x/elision.C: New.
-        * g++.dg/cpp0x/named_refs.C: New.
-        * g++.dg/cpp0x/unnamed_refs.C: New.
-        * g++.dg/cpp0x/rv4n.C: New.
-        * g++.dg/cpp0x/elision_neg.C: New.
-        * g++.dg/init/copy7.C: Run in C++98 mode.
-        * g++.dg/overload/arg1.C: Ditto.
-        * g++.dg/overload/arg4.C: Ditto.
+       * g++.dg/cpp0x/iop.C: New.
+       * g++.dg/cpp0x/rv3n.C: New.
+       * g++.dg/cpp0x/rv7p.C: New.
+       * g++.dg/cpp0x/reference_collapsing.C: New.
+       * g++.dg/cpp0x/overload.C: New.
+       * g++.dg/cpp0x/named.C: New.
+       * g++.dg/cpp0x/rv2p.C: New.
+       * g++.dg/cpp0x/rv6n.C: New.
+       * g++.dg/cpp0x/not_special.C: New.
+       * g++.dg/cpp0x/bind.C: New.
+       * g++.dg/cpp0x/rv1n.C: New.
+       * g++.dg/cpp0x/rv5p.C: New.
+       * g++.dg/cpp0x/elision.C: New.
+       * g++.dg/cpp0x/named_refs.C: New.
+       * g++.dg/cpp0x/unnamed_refs.C: New.
+       * g++.dg/cpp0x/rv4n.C: New.
+       * g++.dg/cpp0x/elision_neg.C: New.
+       * g++.dg/init/copy7.C: Run in C++98 mode.
+       * g++.dg/overload/arg1.C: Ditto.
+       * g++.dg/overload/arg4.C: Ditto.
 
 2007-05-30  Jakub Jelinek  <jakub@redhat.com>
 

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