+ gfc_component *this_comp = NULL;
+
+ if (!comp_head)
+ comp_tail = comp_head = gfc_get_structure_ctor_component ();
+ else
+ {
+ comp_tail->next = gfc_get_structure_ctor_component ();
+ comp_tail = comp_tail->next;
+ }
+ comp_tail->name = XCNEWVEC (char, GFC_MAX_SYMBOL_LEN + 1);
+ comp_tail->val = NULL;
+ comp_tail->where = gfc_current_locus;
+
+ /* Try matching a component name. */
+ if (gfc_match_name (comp_tail->name) == MATCH_YES
+ && gfc_match_char ('=') == MATCH_YES)
+ {
+ if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: Structure"
+ " constructor with named arguments at %C")
+ == FAILURE)
+ goto cleanup;
+
+ last_name = comp_tail->name;
+ comp = NULL;
+ }
+ else
+ {
+ /* Components without name are not allowed after the first named
+ component initializer! */
+ if (!comp)
+ {
+ if (last_name)
+ gfc_error ("Component initializer without name after"
+ " component named %s at %C!", last_name);
+ else
+ gfc_error ("Too many components in structure constructor at"
+ " %C!");
+ goto cleanup;
+ }
+
+ gfc_current_locus = comp_tail->where;
+ strncpy (comp_tail->name, comp->name, GFC_MAX_SYMBOL_LEN + 1);
+ }
+
+ /* Find the current component in the structure definition; this is
+ needed to get its access attribute in the private check below. */
+ if (comp)
+ this_comp = comp;
+ else
+ {
+ for (comp = sym->components; comp; comp = comp->next)
+ if (!strcmp (comp->name, comp_tail->name))
+ {
+ this_comp = comp;
+ break;
+ }
+ comp = NULL; /* Reset needed! */
+
+ /* Here we can check if a component name is given which does not
+ correspond to any component of the defined structure. */
+ if (!this_comp)
+ {
+ gfc_error ("Component '%s' in structure constructor at %C"
+ " does not correspond to any component in the"
+ " constructed structure!", comp_tail->name);
+ goto cleanup;
+ }
+ }
+ gcc_assert (this_comp);
+
+ /* Check the current component's access status. */
+ if (sym->attr.use_assoc && this_comp->access == ACCESS_PRIVATE)
+ {
+ gfc_error ("Component '%s' is PRIVATE in structure constructor"
+ " at %C!", comp_tail->name);
+ goto cleanup;
+ }
+
+ /* Check if this component is already given a value. */
+ for (comp_iter = comp_head; comp_iter != comp_tail;
+ comp_iter = comp_iter->next)
+ {
+ gcc_assert (comp_iter);
+ if (!strcmp (comp_iter->name, comp_tail->name))
+ {
+ gfc_error ("Component '%s' is initialized twice in the"
+ " structure constructor at %C!", comp_tail->name);
+ goto cleanup;
+ }
+ }
+
+ /* Match the current initializer expression. */
+ m = gfc_match_expr (&comp_tail->val);
+ if (m == MATCH_NO)
+ goto syntax;
+ if (m == MATCH_ERROR)
+ goto cleanup;
+
+ if (comp)
+ comp = comp->next;
OSDN Git Service
