A rather obvious patch - see PR for the quote from the standard. Thanks
goes to Bill Long for finding and reporting the issue.
Committed as Rev. 199437 after build+regtesting on x86-64-gnu-linux.
Tobias
2013-05-30 Tobias Burnus <bur...@net-b.de>
PR fortran/57458
* interface.c (compare_parameter): Update C1239/C1240 constraint
check for assumed-rank/TS29113.
2013-05-30 Tobias Burnus <bur...@net-b.de>
PR fortran/57458
* gfortran.dg/assumed_rank_13.f90: New.
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 2f8c6a5..adc4e63 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;
}
--- /dev/null 2013-05-30 08:32:37.588061020 +0200
+++ gcc/gcc/testsuite/gfortran.dg/assumed_rank_13.f90 2013-05-30 09:15:58.302491343 +0200
@@ -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
