+ /* Register the component with the caf-lib before it is initialized.
+ Register only allocatable components, that are not coarray'ed
+ components (%comp[*]). Only register when the constructor is not the
+ null-expression. */
+ if (coarray && !cm->attr.codimension
+ && (cm->attr.allocatable || cm->attr.pointer)
+ && (!c->expr || c->expr->expr_type == EXPR_NULL))
+ {
+ tree token, desc, size;
+ bool is_array = cm->ts.type == BT_CLASS
+ ? CLASS_DATA (cm)->attr.dimension : cm->attr.dimension;
+
+ field = cm->backend_decl;
+ field = fold_build3_loc (input_location, COMPONENT_REF,
+ TREE_TYPE (field), dest, field, NULL_TREE);
+ if (cm->ts.type == BT_CLASS)
+ field = gfc_class_data_get (field);
+
+ token = is_array ? gfc_conv_descriptor_token (field)
+ : fold_build3_loc (input_location, COMPONENT_REF,
+ TREE_TYPE (cm->caf_token), dest,
+ cm->caf_token, NULL_TREE);
+
+ if (is_array)
+ {
+ /* The _caf_register routine looks at the rank of the array
+ descriptor to decide whether the data registered is an array
+ or not. */
+ int rank = cm->ts.type == BT_CLASS ? CLASS_DATA (cm)->as->rank
+ : cm->as->rank;
+ /* When the rank is not known just set a positive rank, which
+ suffices to recognize the data as array. */
+ if (rank < 0)
+ rank = 1;
+ size = integer_zero_node;
+ desc = field;
+ gfc_add_modify (&block, gfc_conv_descriptor_dtype (desc),
+ build_int_cst (gfc_array_index_type, rank));
+ }
+ else
+ {
+ desc = gfc_conv_scalar_to_descriptor (&se, field,
+ cm->ts.type == BT_CLASS
+ ? CLASS_DATA (cm)->attr
+ : cm->attr);
+ size = TYPE_SIZE_UNIT (TREE_TYPE (field));
+ }
+ gfc_add_block_to_block (&block, &se.pre);
+ tmp = build_call_expr_loc (input_location, gfor_fndecl_caf_register,
+ 7, size, build_int_cst (
+ integer_type_node,
+ GFC_CAF_COARRAY_ALLOC_REGISTER_ONLY),
+ gfc_build_addr_expr (pvoid_type_node,
+ token),
+ gfc_build_addr_expr (NULL_TREE, desc),
+ null_pointer_node, null_pointer_node,
+ integer_zero_node);
+ gfc_add_expr_to_block (&block, tmp);
+ }