diff options
Diffstat (limited to 'gcc/fortran/trans.c')
| -rw-r--r-- | gcc/fortran/trans.c | 60 |
1 files changed, 46 insertions, 14 deletions
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 28d1341..9210e0f 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -734,7 +734,7 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size, size = fold_convert (size_type_node, size); tmp = build_call_expr_loc (input_location, - gfor_fndecl_caf_register, 6, + gfor_fndecl_caf_register, 7, fold_build2_loc (input_location, MAX_EXPR, size_type_node, size, build_int_cst (size_type_node, 1)), @@ -742,11 +742,9 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size, lock_var ? GFC_CAF_LOCK_ALLOC : event_var ? GFC_CAF_EVENT_ALLOC : GFC_CAF_COARRAY_ALLOC), - token, pstat, errmsg, errlen); + token, gfc_build_addr_expr (pvoid_type_node, pointer), + pstat, errmsg, errlen); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, - TREE_TYPE (pointer), pointer, - fold_convert ( TREE_TYPE (pointer), tmp)); gfc_add_expr_to_block (block, tmp); /* It guarantees memory consistency within the same segment */ @@ -782,13 +780,15 @@ gfc_allocate_using_lib (stmtblock_t * block, tree pointer, tree size, expr must be set to the original expression being allocated for its locus and variable name in case a runtime error has to be printed. */ void -gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token, - tree status, tree errmsg, tree errlen, tree label_finish, - gfc_expr* expr) +gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, + tree token, tree status, tree errmsg, tree errlen, + tree label_finish, gfc_expr* expr, int corank) { stmtblock_t alloc_block; tree tmp, null_mem, alloc, error; tree type = TREE_TYPE (mem); + symbol_attribute caf_attr; + bool need_assign = false; size = fold_convert (size_type_node, size); null_mem = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, @@ -800,8 +800,11 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token, gfc_allocate_using_lib. */ gfc_start_block (&alloc_block); + if (flag_coarray == GFC_FCOARRAY_LIB) + caf_attr = gfc_caf_attr (expr, true); + if (flag_coarray == GFC_FCOARRAY_LIB - && gfc_expr_attr (expr).codimension) + && (corank > 0 || caf_attr.codimension)) { tree cond; bool lock_var = expr->ts.type == BT_DERIVED @@ -814,6 +817,33 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token, == INTMOD_ISO_FORTRAN_ENV && expr->ts.u.derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE; + gfc_se se; + gfc_init_se (&se, NULL); + + tree sub_caf_tree = gfc_get_ultimate_alloc_ptr_comps_caf_token (&se, + expr); + if (sub_caf_tree == NULL_TREE) + sub_caf_tree = token; + + /* When mem is an array ref, then strip the .data-ref. */ + if (TREE_CODE (mem) == COMPONENT_REF + && !(GFC_ARRAY_TYPE_P (TREE_TYPE (mem)))) + tmp = TREE_OPERAND (mem, 0); + else + tmp = mem; + + if (!(GFC_ARRAY_TYPE_P (TREE_TYPE (tmp)) + && TYPE_LANG_SPECIFIC (TREE_TYPE (tmp))->corank == 0) + && !GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (tmp))) + { + symbol_attribute attr; + + gfc_clear_attr (&attr); + tmp = gfc_conv_scalar_to_descriptor (&se, mem, attr); + need_assign = true; + } + gfc_add_block_to_block (&alloc_block, &se.pre); + /* In the front end, we represent the lock variable as pointer. However, the FE only passes the pointer around and leaves the actual representation to the library. Hence, we have to convert back to the @@ -822,9 +852,11 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token, size = fold_build2_loc (input_location, TRUNC_DIV_EXPR, size_type_node, size, TYPE_SIZE_UNIT (ptr_type_node)); - gfc_allocate_using_lib (&alloc_block, mem, size, token, status, - errmsg, errlen, lock_var, event_var); - + gfc_allocate_using_lib (&alloc_block, tmp, size, sub_caf_tree, + status, errmsg, errlen, lock_var, event_var); + if (need_assign) + gfc_add_modify (&alloc_block, mem, fold_convert (TREE_TYPE (mem), + gfc_conv_descriptor_data_get (tmp))); if (status != NULL_TREE) { TREE_USED (label_finish) = 1; @@ -1362,8 +1394,8 @@ gfc_deallocate_with_status (tree pointer, tree status, tree errmsg, token = gfc_build_addr_expr (NULL_TREE, token); tmp = build_call_expr_loc (input_location, - gfor_fndecl_caf_deregister, 4, - token, pstat, errmsg, errlen); + gfor_fndecl_caf_deregister, 4, + token, pstat, errmsg, errlen); gfc_add_expr_to_block (&non_null, tmp); /* It guarantees memory consistency within the same segment */ |