===================================================================
@@ -323,6 +323,7 @@ enum gfc_isym_id
GFC_ISYM_CHDIR,
GFC_ISYM_CHMOD,
GFC_ISYM_CMPLX,
+ GFC_ISYM_CAF_SEND,
GFC_ISYM_COMMAND_ARGUMENT_COUNT,
GFC_ISYM_COMPILER_OPTIONS,
GFC_ISYM_COMPILER_VERSION,
===================================================================
@@ -2756,7 +2756,7 @@ add_functions (void)
make_generic ("size", GFC_ISYM_SIZE, GFC_STD_F95);
/* Obtain the stride for a given dimensions; to be used only internally.
- "make_from_module" makes inaccessible for external users. */
+ "make_from_module" makes it inaccessible for external users. */
add_sym_2 (GFC_PREFIX ("stride"), GFC_ISYM_STRIDE, CLASS_INQUIRY, ACTUAL_NO,
BT_INTEGER, gfc_index_integer_kind, GFC_STD_GNU,
NULL, NULL, gfc_resolve_stride,
@@ -3209,6 +3209,16 @@ add_subroutines (void)
"fptr", BT_UNKNOWN, 0, REQUIRED, INTENT_OUT);
make_from_module();
+ /* The following function is internally used for coarray libray functions.
+ "make_from_module" makes it inaccessible for external users. */
+ add_sym_3s (GFC_PREFIX ("caf_send"), GFC_ISYM_CAF_SEND, CLASS_IMPURE,
+ BT_UNKNOWN, 0, GFC_STD_GNU, NULL, NULL, NULL,
+ "x", BT_REAL, dr, REQUIRED, INTENT_OUT,
+ "y", BT_REAL, dr, REQUIRED, INTENT_IN,
+ "async", BT_LOGICAL, dl, REQUIRED, INTENT_IN);
+ make_from_module();
+
+
/* More G77 compatibility garbage. */
add_sym_3s ("alarm", GFC_ISYM_ALARM, CLASS_IMPURE, BT_UNKNOWN, 0, GFC_STD_GNU,
gfc_check_alarm_sub, NULL, gfc_resolve_alarm_sub,
===================================================================
@@ -9217,8 +9217,10 @@ resolve_ordinary_assign (gfc_code *code, gfc_names
return false;
}
+ bool lhs_coindexed = gfc_is_coindexed (lhs);
+
/* F2008, Section 7.2.1.2. */
- if (gfc_is_coindexed (lhs) && gfc_has_ultimate_allocatable (lhs))
+ if (lhs_coindexed && gfc_has_ultimate_allocatable (lhs))
{
gfc_error ("Coindexed variable must not have an allocatable ultimate "
"component in assignment at %L", &lhs->where);
@@ -9226,6 +9228,28 @@ resolve_ordinary_assign (gfc_code *code, gfc_names
}
gfc_check_assign (lhs, rhs, 1);
+
+ if (false && lhs_coindexed && gfc_option.coarray == GFC_FCOARRAY_LIB)
+ {
+ code->op = EXEC_CALL;
+ gfc_get_sym_tree (GFC_PREFIX ("caf_send"), ns, &code->symtree, true);
+ code->resolved_sym = code->symtree->n.sym;
+ code->resolved_sym->attr.flavor = FL_PROCEDURE;
+ code->resolved_sym->attr.intrinsic = 1;
+ code->resolved_sym->attr.subroutine = 1;
+ code->resolved_isym = gfc_intrinsic_subroutine_by_id (GFC_ISYM_CAF_SEND);
+ gfc_commit_symbol (code->resolved_sym);
+ code->ext.actual = gfc_get_actual_arglist ();
+ code->ext.actual->expr = lhs;
+ code->ext.actual->next = gfc_get_actual_arglist ();
+ code->ext.actual->next->expr = rhs;
+ code->ext.actual->next->next = gfc_get_actual_arglist ();
+ code->ext.actual->next->next->expr =
+ gfc_get_logical_expr (gfc_default_logical_kind, NULL, false);
+ code->expr1 = NULL;
+ code->expr2 = NULL;
+ }
+
return false;
}
@@ -9861,7 +9885,7 @@ resolve_code (gfc_code *code, gfc_namespace *ns)
}
/* F03 7.4.1.3 for non-allocatable, non-pointer components. */
- if (code->expr1->ts.type == BT_DERIVED
+ if (code->op != EXEC_CALL && code->expr1->ts.type == BT_DERIVED
&& code->expr1->ts.u.derived->attr.defined_assign_comp)
generate_component_assignments (&code, ns);