From de91486c745d5ff6aff491cb9bd1a78875bf090c Mon Sep 17 00:00:00 2001 From: Andre Vehreschild Date: Sat, 7 Jan 2017 18:26:58 +0100 Subject: re PR fortran/78781 ([Coarray] ICE in gfc_deallocate_scalar_with_status, at fortran/trans.c:1588) gcc/fortran/ChangeLog: 2017-01-07 Andre Vehreschild PR fortran/78781 PR fortran/78935 * expr.c (gfc_check_pointer_assign): Return the same error message for rewritten coarray pointer assignments like for plain ones. * gfortran.h: Change prototype. * primary.c (caf_variable_attr): Set attributes used ones only only ones. Add setting of pointer_comp attribute. (gfc_caf_attr): Add setting of pointer_comp attribute. * trans-array.c (gfc_array_allocate): Add flag that the component to allocate is not an ultimate coarray component. Add allocation of pointer arrays. (structure_alloc_comps): Extend nullify to treat pointer components in coarrays correctly. Restructure nullify to remove redundant code. (gfc_nullify_alloc_comp): Allow setting caf_mode flags. * trans-array.h: Change prototype of gfc_nullify_alloc_comp (). * trans-decl.c (generate_coarray_sym_init): Call nullify_alloc_comp for derived type coarrays with pointer components. * trans-expr.c (gfc_trans_structure_assign): Also treat pointer components. (trans_caf_token_assign): Handle assignment of token of scalar pointer components. (gfc_trans_pointer_assignment): Call above routine. * trans-intrinsic.c (conv_expr_ref_to_caf_ref): Add treating pointer components. (gfc_conv_intrinsic_caf_get): Likewise. (conv_caf_send): Likewise. * trans-stmt.c (gfc_trans_allocate): After allocating a derived type in a coarray pre-register the tokens. (gfc_trans_deallocate): Simply determining the coarray type (scalar or array) and deregistering it correctly. * trans-types.c (gfc_typenode_for_spec): Replace in_coarray flag by the actual codim to allow lookup of array types in the cache. (gfc_build_array_type): Likewise. (gfc_get_array_descriptor_base): Likewise. (gfc_get_array_type_bounds): Likewise. (gfc_get_derived_type): Likewise. * trans-types.h: Likewise. * trans.c (gfc_deallocate_with_status): Enable deregistering of all kind of coarray components. (gfc_deallocate_scalar_with_status): Use free() in fcoarray_single mode instead of caf_deregister. libgfortran/ChangeLog: 2017-01-07 Andre Vehreschild PR fortran/78781 PR fortran/78935 * caf/single.c (send_by_ref): Fix addressing of non-allocatable scalar destination components. gcc/testsuite/ChangeLog: 2017-01-07 Andre Vehreschild * gfortran.dg/coarray/ptr_comp_1.f08: New test. * gfortran.dg/coarray/ptr_comp_2.f08: New test. * gfortran.dg/coarray/ptr_comp_3.f08: New test. * gfortran.dg/coarray/ptr_comp_4.f08: New test. * gfortran.dg/coarray_ptr_comp_1.f08: New test. * gfortran.dg/coarray_ptr_comp_2.f08: New test. * gfortran.dg/coarray_ptr_comp_3.f08: New test. From-SVN: r244196 --- gcc/fortran/trans-array.c | 102 ++++++++++++++++++++++++++++------------------ 1 file changed, 63 insertions(+), 39 deletions(-) (limited to 'gcc/fortran/trans-array.c') diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 9a755fb..a3aab8e 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5469,7 +5469,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, gfc_expr **lower; gfc_expr **upper; gfc_ref *ref, *prev_ref = NULL, *coref; - bool allocatable, coarray, dimension, alloc_w_e3_arr_spec = false; + bool allocatable, coarray, dimension, alloc_w_e3_arr_spec = false, + non_ulimate_coarray_ptr_comp; ref = expr->ref; @@ -5483,10 +5484,17 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, { allocatable = expr->symtree->n.sym->attr.allocatable; dimension = expr->symtree->n.sym->attr.dimension; + non_ulimate_coarray_ptr_comp = false; } else { allocatable = prev_ref->u.c.component->attr.allocatable; + /* Pointer components in coarrayed derived types must be treated + specially in that they are registered without a check if the are + already associated. This does not hold for ultimate coarray + pointers. */ + non_ulimate_coarray_ptr_comp = (prev_ref->u.c.component->attr.pointer + && !prev_ref->u.c.component->attr.codimension); dimension = prev_ref->u.c.component->attr.dimension; } @@ -5599,20 +5607,27 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, if (POINTER_TYPE_P (TREE_TYPE (se->expr))) se->expr = build_fold_indirect_ref_loc (input_location, se->expr); - pointer = gfc_conv_descriptor_data_get (se->expr); - STRIP_NOPS (pointer); - if (coarray && flag_coarray == GFC_FCOARRAY_LIB) { + pointer = non_ulimate_coarray_ptr_comp ? se->expr + : gfc_conv_descriptor_data_get (se->expr); token = gfc_conv_descriptor_token (se->expr); token = gfc_build_addr_expr (NULL_TREE, token); } + else + pointer = gfc_conv_descriptor_data_get (se->expr); + STRIP_NOPS (pointer); /* The allocatable variant takes the old pointer as first argument. */ if (allocatable) gfc_allocate_allocatable (&elseblock, pointer, size, token, status, errmsg, errlen, label_finish, expr, coref != NULL ? coref->u.ar.as->corank : 0); + else if (non_ulimate_coarray_ptr_comp && token) + /* The token is set only for GFC_FCOARRAY_LIB mode. */ + gfc_allocate_using_caf_lib (&elseblock, pointer, size, token, status, + errmsg, errlen, + GFC_CAF_COARRAY_ALLOC_ALLOCATE_ONLY); else gfc_allocate_using_malloc (&elseblock, pointer, size, status); @@ -8411,55 +8426,64 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, break; case NULLIFY_ALLOC_COMP: - if (c->attr.pointer || c->attr.proc_pointer + /* Nullify + - allocatable components (regular or in class) + - components that have allocatable components + - pointer components when in a coarray. + Skip everything else especially proc_pointers, which may come + coupled with the regular pointer attribute. */ + if (c->attr.proc_pointer || !(c->attr.allocatable || (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable) - || cmp_has_alloc_comps)) + || (cmp_has_alloc_comps + && ((c->ts.type == BT_DERIVED && !c->attr.pointer) + || (c->ts.type == BT_CLASS + && !CLASS_DATA (c)->attr.class_pointer))) + || (caf_in_coarray (caf_mode) && c->attr.pointer))) continue; - /* Coarrays need the component to be initialized before the api-call - is made. */ - if (c->attr.allocatable && (c->attr.dimension || c->attr.codimension)) - { - comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, - decl, cdecl, NULL_TREE); - gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node); - cmp_has_alloc_comps = false; - } - else if (c->attr.allocatable) + /* Process class components first, because they always have the + pointer-attribute set which would be caught wrong else. */ + if (c->ts.type == BT_CLASS + && (CLASS_DATA (c)->attr.allocatable + || CLASS_DATA (c)->attr.class_pointer)) { - /* Allocatable scalar components. */ + /* Allocatable CLASS components. */ comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); - tmp = fold_build2_loc (input_location, MODIFY_EXPR, - void_type_node, comp, - build_int_cst (TREE_TYPE (comp), 0)); - gfc_add_expr_to_block (&fnblock, tmp); - if (gfc_deferred_strlen (c, &comp)) + + comp = gfc_class_data_get (comp); + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) + gfc_conv_descriptor_data_set (&fnblock, comp, + null_pointer_node); + else { - comp = fold_build3_loc (input_location, COMPONENT_REF, - TREE_TYPE (comp), - decl, comp, NULL_TREE); tmp = fold_build2_loc (input_location, MODIFY_EXPR, - TREE_TYPE (comp), comp, + void_type_node, comp, build_int_cst (TREE_TYPE (comp), 0)); gfc_add_expr_to_block (&fnblock, tmp); } cmp_has_alloc_comps = false; } - else if (c->ts.type == BT_CLASS && CLASS_DATA (c)->attr.allocatable) + /* Coarrays need the component to be nulled before the api-call + is made. */ + else if (c->attr.pointer || c->attr.allocatable) { - /* Allocatable CLASS components. */ comp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); - - comp = gfc_class_data_get (comp); - if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) - gfc_conv_descriptor_data_set (&fnblock, comp, null_pointer_node); + if (c->attr.dimension || c->attr.codimension) + gfc_conv_descriptor_data_set (&fnblock, comp, + null_pointer_node); else + gfc_add_modify (&fnblock, comp, + build_int_cst (TREE_TYPE (comp), 0)); + if (gfc_deferred_strlen (c, &comp)) { + comp = fold_build3_loc (input_location, COMPONENT_REF, + TREE_TYPE (comp), + decl, comp, NULL_TREE); tmp = fold_build2_loc (input_location, MODIFY_EXPR, - void_type_node, comp, + TREE_TYPE (comp), comp, build_int_cst (TREE_TYPE (comp), 0)); gfc_add_expr_to_block (&fnblock, tmp); } @@ -8476,6 +8500,9 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, decl, cdecl, NULL_TREE); if (c->attr.dimension || c->attr.codimension) { + /* Set the dtype, because caf_register needs it. */ + gfc_add_modify (&fnblock, gfc_conv_descriptor_dtype (comp), + gfc_get_dtype (TREE_TYPE (comp))); tmp = fold_build3_loc (input_location, COMPONENT_REF, ctype, decl, cdecl, NULL_TREE); token = gfc_conv_descriptor_token (tmp); @@ -8494,10 +8521,6 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_add_block_to_block (&fnblock, &se.pre); } - /* NULL the member-token before registering it or uninitialized - memory accesses may occur. */ - gfc_add_modify (&fnblock, token, fold_convert (TREE_TYPE (token), - null_pointer_node)); gfc_allocate_using_caf_lib (&fnblock, comp, size_zero_node, gfc_build_addr_expr (NULL_TREE, token), @@ -8711,11 +8734,12 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, nullify allocatable components. */ tree -gfc_nullify_alloc_comp (gfc_symbol * der_type, tree decl, int rank) +gfc_nullify_alloc_comp (gfc_symbol * der_type, tree decl, int rank, + int caf_mode) { return structure_alloc_comps (der_type, decl, NULL_TREE, rank, NULLIFY_ALLOC_COMP, - GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY); + GFC_STRUCTURE_CAF_MODE_ENABLE_COARRAY | caf_mode); } -- cgit v1.1