aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/fortran/ChangeLog12
-rw-r--r--gcc/fortran/trans-array.c1
-rw-r--r--gcc/fortran/trans-decl.c37
-rw-r--r--gcc/fortran/trans-expr.c30
-rw-r--r--gcc/fortran/trans-types.c15
-rw-r--r--gcc/fortran/trans.h4
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gfortran.dg/coarray_lib_token_4.f9053
8 files changed, 136 insertions, 20 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1c4a673..5cab38d 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,17 @@
2011-08-25 Tobias Burnus <burnus@net-b.de>
+ * trans-array.c (gfc_conv_descriptor_token): Add assert.
+ * trans-decl.c (gfc_build_qualified_array,
+ create_function_arglist): Handle assumed-shape arrays.
+ * trans-expr.c (gfc_conv_procedure_call): Ditto.
+ * trans-types.c (gfc_get_array_descriptor_base): Ditto, don't
+ add "caf_token" to assumed-shape descriptors, new akind argument.
+ (gfc_get_array_type_bounds): Pass akind.
+ * trans.h (lang_decl): New elements caf_offset and token.
+ (GFC_DECL_TOKEN, GFC_DECL_CAF_OFFSET): New macros.
+
+2011-08-25 Tobias Burnus <burnus@net-b.de>
+
* trans-array.c (structure_alloc_comps): Fix for allocatable
scalar coarray components.
* trans-expr.c (gfc_conv_component_ref): Ditto.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index bd9e88e..6dc1e17 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -277,6 +277,7 @@ gfc_conv_descriptor_token (tree desc)
type = TREE_TYPE (desc);
gcc_assert (GFC_DESCRIPTOR_TYPE_P (type));
+ gcc_assert (GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ALLOCATABLE);
gcc_assert (gfc_option.coarray == GFC_FCOARRAY_LIB);
field = gfc_advance_chain (TYPE_FIELDS (type), CAF_TOKEN_FIELD);
gcc_assert (field != NULL_TREE && TREE_TYPE (field) == prvoid_type_node);
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index cdbb375..1059a42 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -755,6 +755,7 @@ gfc_build_qualified_array (tree decl, gfc_symbol * sym)
&& !sym->attr.contained;
if (sym->attr.codimension && gfc_option.coarray == GFC_FCOARRAY_LIB
+ && sym->as->type != AS_ASSUMED_SHAPE
&& GFC_TYPE_ARRAY_CAF_TOKEN (type) == NULL_TREE)
{
tree token;
@@ -2104,12 +2105,11 @@ create_function_arglist (gfc_symbol * sym)
f->sym->backend_decl = parm;
- /* Coarrays which do not use a descriptor pass with -fcoarray=lib the
- token and the offset as hidden arguments. */
+ /* Coarrays which are descriptorless or assumed-shape pass with
+ -fcoarray=lib the token and the offset as hidden arguments. */
if (f->sym->attr.codimension
&& gfc_option.coarray == GFC_FCOARRAY_LIB
- && !f->sym->attr.allocatable
- && f->sym->as->type != AS_ASSUMED_SHAPE)
+ && !f->sym->attr.allocatable)
{
tree caf_type;
tree token;
@@ -2119,12 +2119,24 @@ create_function_arglist (gfc_symbol * sym)
&& !sym->attr.is_bind_c);
caf_type = TREE_TYPE (f->sym->backend_decl);
- gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) == NULL_TREE);
token = build_decl (input_location, PARM_DECL,
create_tmp_var_name ("caf_token"),
build_qualified_type (pvoid_type_node,
TYPE_QUAL_RESTRICT));
- GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) = token;
+ if (f->sym->as->type == AS_ASSUMED_SHAPE)
+ {
+ gcc_assert (DECL_LANG_SPECIFIC (f->sym->backend_decl) == NULL
+ || GFC_DECL_TOKEN (f->sym->backend_decl) == NULL_TREE);
+ if (DECL_LANG_SPECIFIC (f->sym->backend_decl) == NULL)
+ gfc_allocate_lang_decl (f->sym->backend_decl);
+ GFC_DECL_TOKEN (f->sym->backend_decl) = token;
+ }
+ else
+ {
+ gcc_assert (GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) == NULL_TREE);
+ GFC_TYPE_ARRAY_CAF_TOKEN (caf_type) = token;
+ }
+
DECL_CONTEXT (token) = fndecl;
DECL_ARTIFICIAL (token) = 1;
DECL_ARG_TYPE (token) = TREE_VALUE (typelist);
@@ -2132,12 +2144,21 @@ create_function_arglist (gfc_symbol * sym)
hidden_arglist = chainon (hidden_arglist, token);
gfc_finish_decl (token);
- gcc_assert (GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) == NULL_TREE);
offset = build_decl (input_location, PARM_DECL,
create_tmp_var_name ("caf_offset"),
gfc_array_index_type);
- GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) = offset;
+ if (f->sym->as->type == AS_ASSUMED_SHAPE)
+ {
+ gcc_assert (GFC_DECL_CAF_OFFSET (f->sym->backend_decl)
+ == NULL_TREE);
+ GFC_DECL_CAF_OFFSET (f->sym->backend_decl) = offset;
+ }
+ else
+ {
+ gcc_assert (GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) == NULL_TREE);
+ GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) = offset;
+ }
DECL_CONTEXT (offset) = fndecl;
DECL_ARTIFICIAL (offset) = 1;
DECL_ARG_TYPE (offset) = TREE_VALUE (typelist);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 531a135..628930a 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -3391,11 +3391,11 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
if (parmse.string_length != NULL_TREE && !sym->attr.is_bind_c)
VEC_safe_push (tree, gc, stringargs, parmse.string_length);
- /* For descriptorless coarrays, we pass the token and the offset
- as additional arguments. */
+ /* For descriptorless coarrays and assumed-shape coarray dummies, we
+ pass the token and the offset as additional arguments. */
if (fsym && fsym->attr.codimension
&& gfc_option.coarray == GFC_FCOARRAY_LIB
- && !fsym->attr.allocatable && fsym->as->type != AS_ASSUMED_SHAPE
+ && !fsym->attr.allocatable
&& e == NULL)
{
/* Token and offset. */
@@ -3405,7 +3405,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
gcc_assert (fsym->attr.optional);
}
else if (fsym && fsym->attr.codimension
- && !fsym->attr.allocatable && fsym->as->type != AS_ASSUMED_SHAPE
+ && !fsym->attr.allocatable
&& gfc_option.coarray == GFC_FCOARRAY_LIB)
{
tree caf_decl, caf_type;
@@ -3414,8 +3414,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
caf_decl = get_tree_for_caf_expr (e);
caf_type = TREE_TYPE (caf_decl);
- if (GFC_DESCRIPTOR_TYPE_P (caf_type))
+ if (GFC_DESCRIPTOR_TYPE_P (caf_type)
+ && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE)
tmp = gfc_conv_descriptor_token (caf_decl);
+ else if (DECL_LANG_SPECIFIC (caf_decl)
+ && GFC_DECL_TOKEN (caf_decl) != NULL_TREE)
+ tmp = GFC_DECL_TOKEN (caf_decl);
else
{
gcc_assert (GFC_ARRAY_TYPE_P (caf_type)
@@ -3425,8 +3429,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
VEC_safe_push (tree, gc, stringargs, tmp);
- if (GFC_DESCRIPTOR_TYPE_P (caf_type))
+ if (GFC_DESCRIPTOR_TYPE_P (caf_type)
+ && GFC_TYPE_ARRAY_AKIND (caf_type) == GFC_ARRAY_ALLOCATABLE)
offset = build_int_cst (gfc_array_index_type, 0);
+ else if (DECL_LANG_SPECIFIC (caf_decl)
+ && GFC_DECL_CAF_OFFSET (caf_decl) != NULL_TREE)
+ offset = GFC_DECL_CAF_OFFSET (caf_decl);
else if (GFC_TYPE_ARRAY_CAF_OFFSET (caf_type) != NULL_TREE)
offset = GFC_TYPE_ARRAY_CAF_OFFSET (caf_type);
else
@@ -3440,7 +3448,15 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
tmp = caf_decl;
}
- if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse.expr)))
+ if (fsym->as->type == AS_ASSUMED_SHAPE)
+ {
+ gcc_assert (POINTER_TYPE_P (TREE_TYPE (parmse.expr)));
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE
+ (TREE_TYPE (parmse.expr))));
+ tmp2 = build_fold_indirect_ref_loc (input_location, parmse.expr);
+ tmp2 = gfc_conv_descriptor_data_get (tmp2);
+ }
+ else if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (parmse.expr)))
tmp2 = gfc_conv_descriptor_data_get (parmse.expr);
else
{
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index bac5b31..f66878a 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1614,10 +1614,12 @@ gfc_get_nodesc_array_type (tree etype, gfc_array_spec * as, gfc_packed packed,
return type;
}
+
/* Return or create the base type for an array descriptor. */
static tree
-gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
+gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted,
+ enum gfc_array_kind akind)
{
tree fat_type, decl, arraytype, *chain = NULL;
char name[16 + 2*GFC_RANK_DIGITS + 1 + 1];
@@ -1671,7 +1673,8 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
arraytype, &chain);
TREE_NO_WARNING (decl) = 1;
- if (gfc_option.coarray == GFC_FCOARRAY_LIB && codimen)
+ if (gfc_option.coarray == GFC_FCOARRAY_LIB && codimen
+ && akind == GFC_ARRAY_ALLOCATABLE)
{
decl = gfc_add_field_to_struct_1 (fat_type,
get_identifier ("token"),
@@ -1683,7 +1686,8 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
gfc_finish_type (fat_type);
TYPE_DECL_SUPPRESS_DEBUG (TYPE_STUB_DECL (fat_type)) = 1;
- if (gfc_option.coarray == GFC_FCOARRAY_LIB && codimen)
+ if (gfc_option.coarray == GFC_FCOARRAY_LIB && codimen
+ && akind == GFC_ARRAY_ALLOCATABLE)
gfc_array_descriptor_base_caf[idx] = fat_type;
else
gfc_array_descriptor_base[idx] = fat_type;
@@ -1691,6 +1695,7 @@ gfc_get_array_descriptor_base (int dimen, int codimen, bool restricted)
return fat_type;
}
+
/* Build an array (descriptor) type with given bounds. */
tree
@@ -1703,11 +1708,11 @@ gfc_get_array_type_bounds (tree etype, int dimen, int codimen, tree * lbound,
const char *type_name;
int n;
- base_type = gfc_get_array_descriptor_base (dimen, codimen, restricted);
+ base_type = gfc_get_array_descriptor_base (dimen, codimen, restricted, akind);
fat_type = build_distinct_type_copy (base_type);
/* Make sure that nontarget and target array type have the same canonical
type (and same stub decl for debug info). */
- base_type = gfc_get_array_descriptor_base (dimen, codimen, false);
+ base_type = gfc_get_array_descriptor_base (dimen, codimen, false, akind);
TYPE_CANONICAL (fat_type) = base_type;
TYPE_STUB_DECL (fat_type) = TYPE_STUB_DECL (base_type);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index bb94780..0c249a6 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -750,12 +750,16 @@ struct GTY((variable_size)) lang_decl {
tree stringlen;
tree addr;
tree span;
+ /* For assumed-shape coarrays. */
+ tree token, caf_offset;
};
#define GFC_DECL_ASSIGN_ADDR(node) DECL_LANG_SPECIFIC(node)->addr
#define GFC_DECL_STRING_LEN(node) DECL_LANG_SPECIFIC(node)->stringlen
#define GFC_DECL_SPAN(node) DECL_LANG_SPECIFIC(node)->span
+#define GFC_DECL_TOKEN(node) DECL_LANG_SPECIFIC(node)->token
+#define GFC_DECL_CAF_OFFSET(node) DECL_LANG_SPECIFIC(node)->caf_offset
#define GFC_DECL_SAVED_DESCRIPTOR(node) \
(DECL_LANG_SPECIFIC(node)->saved_descriptor)
#define GFC_DECL_PACKED_ARRAY(node) DECL_LANG_FLAG_0(node)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 30b48b4..c904def 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,9 @@
2011-08-25 Tobias Burnus <burnus@net-b.de>
+ * gfortran.dg/coarray_lib_token_4.f90: New.
+
+2011-08-25 Tobias Burnus <burnus@net-b.de>
+
* gfortran.dg/coarray/alloc_comp_1.f90: New.
2011-08-25 Richard Guenther <rguenther@suse.de>
diff --git a/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90 b/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90
new file mode 100644
index 0000000..2616d25
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_lib_token_4.f90
@@ -0,0 +1,53 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=lib -fdump-tree-original" }
+!
+! Check argument passing with assumed-shape coarray dummies
+!
+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
+ call bar (x)
+ call expl (y)
+ end subroutine foo
+
+ subroutine bar(y)
+ integer :: y(:)[*]
+ end subroutine bar
+
+ subroutine expl(z)
+ integer :: z(*)[*]
+ end subroutine expl
+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 "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 "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" } }
+! { d_g-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" } }
+!
+! { dg-final { scan-tree-dump-times "expl \\(\\(integer\\(kind=4\\).0:. .\\) parm.\[0-9\]+.data, caf_token.\[0-9\]+, \\(\\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(\\(integer\\(kind=.\\)\\) y.\[0-9\]+\\) \\+ caf_offset.\[0-9\]+\\);" 0 "original" } }
+!
+! { dg-final { scan-tree-dump-times "foo \\(&a, &a, &C.\[0-9\]+, a.token, 0, a.token, 0\\);" 1 "original" } }
+!
+! { dg-final { scan-tree-dump-times "foo \\(&parm.\[0-9\]+, &parm.\[0-9\]+, &C.\[0-9\]+, a.token, \\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) a.data, caf_token.\[0-9\]+, \\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) b\\);" 1 "original" } }
+!
+! { dg-final { scan-tree-dump-times "foo \\(&parm.\[0-9\]+, &a, &C.\[0-9\]+, caf_token.\[0-9\]+, \\(integer\\(kind=.\\)\\) parm.\[0-9\]+.data - \\(integer\\(kind=.\\)\\) b, a.token, 0\\);" 1 "original" } }
+!
+! { dg-final { cleanup-tree-dump "original" } }
generated by cgit v1.1 at 2025-06-01 19:00:39 +0000