diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index bd9cdcbb8c6..0300b1d4aac 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-05-15 Tobias Burnus + + PR fortran/18918 + actual argument is not an array; rank mismatch is diagnosted later. + * trans-decl.c (gfc_get_symbol_decl, gfc_trans_deferred_vars): Handle + scalar coarrays. + * trans-types.c (gfc_get_array_type_bounds): Ditto. + 2011-05-15 Joern Rennecke PR middle-end/46500 diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index f0138b0076c..d77148400f9 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -1228,7 +1228,8 @@ gfc_get_symbol_decl (gfc_symbol * sym) } /* Use a copy of the descriptor for dummy arrays. */ - if (sym->attr.dimension && !TREE_USED (sym->backend_decl)) + if ((sym->attr.dimension || sym->attr.codimension) + && !TREE_USED (sym->backend_decl)) { decl = gfc_build_dummy_array_decl (sym, sym->backend_decl); /* Prevent the dummy from being detected as unused if it is copied. */ @@ -1316,7 +1317,7 @@ gfc_get_symbol_decl (gfc_symbol * sym) DECL_IGNORED_P (decl) = 1; } - if (sym->attr.dimension) + if (sym->attr.dimension || sym->attr.codimension) { /* Create variables to hold the non-constant bits of array info. */ gfc_build_qualified_array (decl, sym); @@ -3435,7 +3436,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) if (sym->assoc) continue; - if (sym->attr.dimension) + if (sym->attr.dimension || sym->attr.codimension) { switch (sym->as->type) { diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c index 9874d1625e8..24fdcf3b293 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.c @@ -1683,9 +1683,10 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound, stride = gfc_index_one_node; else stride = NULL_TREE; - for (n = 0; n < dimen; n++) + for (n = 0; n < dimen + codimen; n++) { - GFC_TYPE_ARRAY_STRIDE (fat_type, n) = stride; + if (n < dimen) + GFC_TYPE_ARRAY_STRIDE (fat_type, n) = stride; if (lbound) lower = lbound[n]; @@ -1700,6 +1701,9 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound, lower = NULL_TREE; } + if (codimen && n == dimen + codimen - 1) + break; + upper = ubound[n]; if (upper != NULL_TREE) { @@ -1709,6 +1713,9 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound, upper = NULL_TREE; } + if (n >= dimen) + continue; + if (upper != NULL_TREE && lower != NULL_TREE && stride != NULL_TREE) { tmp = fold_build2_loc (input_location, MINUS_EXPR, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b7a8f50d593..94fa4742bb5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-05-15 Tobias Burnus + + PR fortran/18918 + * gfortran.dg/coarray/image_index_2.f90: New. + 2011-05-13 Ville Voutilainen * g++.dg/cpp0x/override1.C: Move from inherit/virtual9.C. diff --git a/gcc/testsuite/gfortran.dg/coarray/image_index_2.f90 b/gcc/testsuite/gfortran.dg/coarray/image_index_2.f90 new file mode 100644 index 00000000000..794781c7add --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/image_index_2.f90 @@ -0,0 +1,76 @@ +! { dg-do run } +! +! Scalar coarray +! +! Run-time test for IMAGE_INDEX with cobounds only known at +! the compile time, suitable for any number of NUM_IMAGES() +! For compile-time cobounds, the -fcoarray=lib version still +! needs to run-time evalulation if image_index returns > 1 +! as image_index is 0 if the index would exceed num_images(). +! +! Please set num_images() to >= 13, if possible. +! +! PR fortran/18918 +! + +program test_image_index +implicit none +integer :: index1, index2, index3 +logical :: one + +integer, save :: d[-1:3, *] +integer, save :: e[-1:-1, 3:*] + +one = num_images() == 1 + +index1 = image_index(d, [-1, 1] ) +index2 = image_index(d, [0, 1] ) + +if (one .and. (index1 /= 1 .or. index2 /= 0)) & + call abort() +if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) & + call abort() + +index1 = image_index(e, [-1, 3] ) +index2 = image_index(e, [-1, 4] ) + +if (one .and. (index1 /= 1 .or. index2 /= 0)) & + call abort() +if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) & + call abort() + +call test(1, e, d, e) +call test(2, e, d, e) + +contains +subroutine test(n, a, b, c) + integer :: n + integer :: a[3*n:3*n, -4*n:-3*n, 88*n:*], b[-1*n:0*n,0*n:*], c[*] + + index1 = image_index(a, [3*n, -4*n, 88*n] ) + index2 = image_index(b, [-1, 0] ) + index3 = image_index(c, [1] ) + + if (n == 1) then + if (index1 /= 1 .or. index2 /= 1 .or. index3 /= 1) call abort() + else if (num_images() == 1) then + if (index1 /= 1 .or. index2 /= 0 .or. index3 /= 1) call abort() + else + if (index1 /= 1 .or. index2 /= 2 .or. index3 /= 1) call abort() + end if + + index1 = image_index(a, [3*n, -3*n, 88*n] ) + index2 = image_index(b, [0, 0] ) + index3 = image_index(c, [2] ) + + if (one .and. (index1 /= 0 .or. index2 /= 0 .or. index3 /= 0)) & + call abort() + if (n == 1 .and. num_images() == 2) then + if (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2) & + call abort() + else if (n == 2 .and. num_images() == 2) then + if (index1 /= 0 .or. index2 /= 0 .or. index3 /= 2) & + call abort() + end if +end subroutine test +end program test_image_index