This patch fixes two issues:
a) ucobound(x) of an assumed-size array was wrongly rejected.
b) For assumed-shape arrays, the dummy argument expected an array
descriptor, which contains the codimension. However, only for
allocatable coarrays, the coshape is stored in the descriptor - for all
others, the corank and the coshape is defined at dummy declaration time.
- Consequently, we also only passed for assumed-shape dummies the shape
- and used the local coshape. Except: the tree decl to the dummy
variable expected a descriptor of rank+corank size.
Fortunately, simply fixing the typedecl of the descriptor was sufficient.
Build and regtested on x86-64-gnu-linux.
OK for the trunk?
Tobias
PS: The last lines of the patch require
http://gcc.gnu.org/ml/fortran/2014-04/msg00091.html to be applied as
they modify the dump of the latter.
2014-04-27 Tobias Burnus <bur...@net-b.de>
* resolve.c (resolve_function): Don't do
assumed-size check for lcobound/ucobound.
* trans-types.c (gfc_build_array_type): Only build an array
descriptor with codimensions for allocatable coarrays.
2014-04-27 Tobias Burnus <bur...@net-b.de>
* gfortran.dg/coarray_lib_this_image_2.f90: Update dump.
* gfortran.dg/coarray_lib_token_4.f90: Ditto.
* gfortran.dg/coarray/codimension.f90: New.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 38755fe..15c9463 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -2942,6 +2942,8 @@ resolve_function (gfc_expr *expr)
else if (expr->value.function.actual != NULL
&& expr->value.function.isym != NULL
&& GENERIC_ID != GFC_ISYM_LBOUND
+ && GENERIC_ID != GFC_ISYM_LCOBOUND
+ && GENERIC_ID != GFC_ISYM_UCOBOUND
&& GENERIC_ID != GFC_ISYM_LEN
&& GENERIC_ID != GFC_ISYM_LOC
&& GENERIC_ID != GFC_ISYM_C_LOC
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 243feb7..f693712 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1303,7 +1303,14 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
{
tree lbound[GFC_MAX_DIMENSIONS];
tree ubound[GFC_MAX_DIMENSIONS];
- int n;
+ int n, corank;
+
+ /* Assumed-shape arrays do not have codimension information stored in the
+ descriptor. */
+ corank = as->corank;
+ if (as->type == AS_ASSUMED_SHAPE ||
+ (as->type == AS_ASSUMED_RANK && akind == GFC_ARRAY_ALLOCATABLE))
+ corank = 0;
if (as->type == AS_ASSUMED_RANK)
for (n = 0; n < GFC_MAX_DIMENSIONS; n++)
@@ -1322,14 +1329,14 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
ubound[n] = gfc_conv_array_bound (as->upper[n]);
}
- for (n = as->rank; n < as->rank + as->corank; n++)
+ for (n = as->rank; n < as->rank + corank; n++)
{
if (as->type != AS_DEFERRED && as->lower[n] == NULL)
lbound[n] = gfc_index_one_node;
else
lbound[n] = gfc_conv_array_bound (as->lower[n]);
- if (n < as->rank + as->corank - 1)
+ if (n < as->rank + corank - 1)
ubound[n] = gfc_conv_array_bound (as->upper[n]);
}
@@ -1341,7 +1348,7 @@ gfc_build_array_type (tree type, gfc_array_spec * as,
: GFC_ARRAY_ASSUMED_RANK;
return gfc_get_array_type_bounds (type, as->rank == -1
? GFC_MAX_DIMENSIONS : as->rank,
- as->corank, lbound,
+ corank, lbound,
ubound, 0, akind, restricted);
}
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90
index 43da9f4..9e445f4 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90
@@ -35,9 +35,9 @@ end program test_caf
! { dg-final { scan-tree-dump-times "expl \\(integer\\(kind=4\\).0:. . restrict z, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
!
-! { dg-final { scan-tree-dump-times "bar \\(struct array2_integer\\(kind=4\\) & restrict y, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(struct array1_integer\\(kind=4\\) & restrict y, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
!
-! { dg-final { scan-tree-dump-times "foo \\(struct array2_integer\\(kind=4\\) & restrict x, struct array2_integer\\(kind=4\\) & restrict y, integer\\(kind=4\\) & restrict test, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "foo \\(struct array1_integer\\(kind=4\\) & restrict x, struct array1_integer\\(kind=4\\) & restrict y, integer\\(kind=4\\) & restrict test, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+, void . restrict caf_token.\[0-9\]+, integer\\(kind=.\\) caf_offset.\[0-9\]+\\)" 1 "original" } }
!
! { dg-final { scan-tree-dump-times "bar \\(&parm.\[0-9\]+, caf_token.\[0-9\]+, \\(\\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) x.\[0-9\]+\\) \\+ caf_offset.\[0-9\]+\\);" 1 "original" } }
!
--- /dev/null 2014-04-23 17:58:54.386702372 +0200
+++ gcc/gcc/testsuite/gfortran.dg/coarray/codimension.f90 2014-04-27 18:02:08.917626623 +0200
@@ -0,0 +1,49 @@
+! { dg-do run }
+!
+! Based on coarray_lib_token_4.f90 but checking whether the bounds
+! are correctly handled.
+!
+program test_caf
+ implicit none
+ integer, allocatable :: A(:)[:]
+ integer, save :: B(3)[*]
+ integer :: i
+
+ allocate (A(3)[*])
+ A = [1, 2, 3 ]
+ B = [9, 7, 4 ]
+ call foo (A, A, test=1)
+ call foo (A(2:3), B, test=2)
+ call foo (B, A, test=3)
+contains
+ subroutine foo(x, y, test)
+ integer :: x(:)[*]
+ integer, contiguous :: y(:)[*]
+ integer :: test
+ integer :: i, j
+ call bar (x)
+ call expl (y)
+ i = lcobound(x, dim=1)
+ j = ucobound(x, dim=1)
+ if (i /= 1 .or. j /= num_images()) call abort()
+ i = lcobound(y, dim=1)
+ j = ucobound(y, dim=1)
+ if (i /= 1 .or. j /= num_images()) call abort()
+ end subroutine foo
+
+ subroutine bar(y)
+ integer :: y(:)[*]
+ integer :: i, j
+ i = lcobound(y, dim=1)
+ j = ucobound(y, dim=1)
+ if (i /= 1 .or. j /= num_images()) call abort()
+ end subroutine bar
+
+ subroutine expl(z)
+ integer :: z(*)[*]
+ integer :: i, j
+ i = lcobound(z, dim=1)
+ j = ucobound(z, dim=1)
+ if (i /= 1 .or. j /= num_images()) call abort()
+ end subroutine expl
+end program test_caf
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
index 6b961e6..f2c259f 100644
--- a/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_this_image_2.f90
@@ -16,7 +16,7 @@ contains
end subroutine bar
end
-! { dg-final { scan-tree-dump-times "bar \\(struct array2_real\\(kind=4\\) & restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
+! { dg-final { scan-tree-dump-times "bar \\(struct array1_real\\(kind=4\\) & restrict x, void \\* restrict caf_token.., integer\\(kind=8\\) caf_offset..\\)" 1 "original" } }
! { dg-final { scan-tree-dump-times "mylcobound = 5;" 1 "original" } }
! { dg-final { scan-tree-dump-times "parm...dim\\\[1\\\].lbound = 5;" 1 "original" } }
! { dg-final { scan-tree-dump-times "myucobound = \\(integer\\(kind=4\\)\\) \\(\\(\\(unsigned int\\) parm...dim\\\[1\\\].lbound \\+ \\(unsigned int\\) _gfortran_caf_num_images \\(0, -1\\)\\) \\+ 4294967295\\);" 1 "original" } }
