2013-05-30 Tobias Burnus <burnus@net-b.de>

        PR fortran/57458
        * interface.c (compare_parameter): Update C1239/C1240 constraint
        check for assumed-rank/TS29113.

2013-05-30  Tobias Burnus  <burnus@net-b.de>

        PR fortran/57458
        * gfortran.dg/assumed_rank_13.f90: New.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@199437 138bc75d-0d04-0410-961f-82ee72b054a4

4 files changed, 47 insertions, 9 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4ecf60b22df..87aa9bce433 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,4 +1,10 @@
-2013-05-28  Tobias Burnus  <burnus@net-b.de>
+2013-05-30  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/57458
+	* interface.c (compare_parameter): Update C1239/C1240 constraint
+	check for assumed-rank/TS29113.
+
+2013-05-29  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/37336
 	* class.c (finalize_component): Fix coarray array refs.
@@ -15,7 +21,7 @@
 	BT_CLASS allocations.
 	* trans-stmt.c (gfc_trans_allocate): Ditto.
 
-2013-05-28  Tobias Burnus  <burnus@net-b.de>
+2013-05-29  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/37336
 	* resolve.c (gfc_resolve_finalizers): Remove not implemented error.
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 2f8c6a5e54f..adc4e63845f 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2031,14 +2031,15 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
          || actual->symtree->n.sym->attr.volatile_)
       &&  (formal->attr.asynchronous || formal->attr.volatile_)
       && actual->rank && !gfc_is_simply_contiguous (actual, true)
-      && ((formal->as->type != AS_ASSUMED_SHAPE && !formal->attr.pointer)
+      && ((formal->as->type != AS_ASSUMED_SHAPE
+	   && formal->as->type != AS_ASSUMED_RANK && !formal->attr.pointer)
 	  || formal->attr.contiguous))
     {
       if (where)
-	gfc_error ("Dummy argument '%s' has to be a pointer or assumed-shape "
-		   "array without CONTIGUOUS attribute - as actual argument at"
-		   " %L is not simply contiguous and both are ASYNCHRONOUS "
-		   "or VOLATILE", formal->name, &actual->where);
+	gfc_error ("Dummy argument '%s' has to be a pointer, assumed-shape or "
+		   "assumed-rank array without CONTIGUOUS attribute - as actual"
+		   " argument at %L is not simply contiguous and both are "
+		   "ASYNCHRONOUS or VOLATILE", formal->name, &actual->where);
       return 0;
     }
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 64b0f58c158..d51376dff39 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-05-30  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/57458
+	* gfortran.dg/assumed_rank_13.f90: New.
+
 2013-05-29  Easwaran Raman  <eraman@google.com>
 
 	PR tree-optimization/57442
@@ -13,7 +18,7 @@
 	PR testsuite/57413
 	* gcc.dg/debug/dwarf2/discriminator.c: Restrict the test to linux-gnu.
 
-2013-05-28  Tobias Burnus  <burnus@net-b.de>
+2013-05-29  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/37336
 	* gfortran.dg/auto_dealloc_2.f90: Update _free count in the dump.
@@ -65,7 +70,7 @@
 	* c-c++-common/cilk-plus/AN/test_sec_limits.c: Likewise.
 	* gcc.dg/cilk-plus/cilk-plus.exp: New script.
 
-2013-05-28  Tobias Burnus  <burnus@net-b.de>
+2013-05-29  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/37336
 	* gfortran.dg/finalize_11.f90: New.
diff --git a/gcc/testsuite/gfortran.dg/assumed_rank_13.f90 b/gcc/testsuite/gfortran.dg/assumed_rank_13.f90
new file mode 100644
index 00000000000..99a982b33ed
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/assumed_rank_13.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+!
+! PR fortran/57458
+!
+!
+
+  integer, pointer, asynchronous :: i(:)
+  integer, pointer, volatile :: j(:)
+  call foo(i)
+  call foo2(i)
+  call foo3(j)
+  call foo4(j)
+contains
+  subroutine foo(x)
+    type(*), dimension(:), asynchronous :: x
+  end subroutine foo
+  subroutine foo2(x)
+    type(*), dimension(..), asynchronous :: x
+  end subroutine foo2
+  subroutine foo3(x)
+    type(*), dimension(:), asynchronous :: x
+  end subroutine foo3
+  subroutine foo4(x)
+    type(*), dimension(..), asynchronous :: x
+  end subroutine foo4
+end