+
+static try
+resolve_fl_namelist (gfc_symbol *sym)
+{
+ gfc_namelist *nl;
+ gfc_symbol *nlsym;
+
+ /* Reject PRIVATE objects in a PUBLIC namelist. */
+ if (gfc_check_access(sym->attr.access, sym->ns->default_access))
+ {
+ for (nl = sym->namelist; nl; nl = nl->next)
+ {
+ if (!nl->sym->attr.use_assoc
+ && !(sym->ns->parent == nl->sym->ns)
+ && !gfc_check_access(nl->sym->attr.access,
+ nl->sym->ns->default_access))
+ {
+ gfc_error ("PRIVATE symbol '%s' cannot be member of "
+ "PUBLIC namelist at %L", nl->sym->name,
+ &sym->declared_at);
+ return FAILURE;
+ }
+ }
+ }
+
+ /* Reject namelist arrays that are not constant shape. */
+ for (nl = sym->namelist; nl; nl = nl->next)
+ {
+ if (is_non_constant_shape_array (nl->sym))
+ {
+ gfc_error ("The array '%s' must have constant shape to be "
+ "a NAMELIST object at %L", nl->sym->name,
+ &sym->declared_at);
+ return FAILURE;
+ }
+ }
+
+ /* 14.1.2 A module or internal procedure represent local entities
+ of the same type as a namelist member and so are not allowed.
+ Note that this is sometimes caught by check_conflict so the
+ same message has been used. */
+ for (nl = sym->namelist; nl; nl = nl->next)
+ {
+ nlsym = NULL;
+ if (sym->ns->parent && nl->sym && nl->sym->name)
+ gfc_find_symbol (nl->sym->name, sym->ns->parent, 0, &nlsym);
+ if (nlsym && nlsym->attr.flavor == FL_PROCEDURE)
+ {
+ gfc_error ("PROCEDURE attribute conflicts with NAMELIST "
+ "attribute in '%s' at %L", nlsym->name,
+ &sym->declared_at);
+ return FAILURE;
+ }
+ }
+
+ return SUCCESS;
+}
+
+
+static try
+resolve_fl_parameter (gfc_symbol *sym)
+{
+ /* A parameter array's shape needs to be constant. */
+ if (sym->as != NULL && !gfc_is_compile_time_shape (sym->as))
+ {
+ gfc_error ("Parameter array '%s' at %L cannot be automatic "
+ "or assumed shape", sym->name, &sym->declared_at);
+ return FAILURE;
+ }
+
+ /* Make sure a parameter that has been implicitly typed still
+ matches the implicit type, since PARAMETER statements can precede
+ IMPLICIT statements. */
+ if (sym->attr.implicit_type
+ && !gfc_compare_types (&sym->ts,
+ gfc_get_default_type (sym, sym->ns)))
+ {
+ gfc_error ("Implicitly typed PARAMETER '%s' at %L doesn't match a "
+ "later IMPLICIT type", sym->name, &sym->declared_at);
+ return FAILURE;
+ }
+
+ /* Make sure the types of derived parameters are consistent. This
+ type checking is deferred until resolution because the type may
+ refer to a derived type from the host. */
+ if (sym->ts.type == BT_DERIVED
+ && !gfc_compare_types (&sym->ts, &sym->value->ts))
+ {
+ gfc_error ("Incompatible derived type in PARAMETER at %L",
+ &sym->value->where);
+ return FAILURE;
+ }
+ return SUCCESS;
+}
+
+
+/* Do anything necessary to resolve a symbol. Right now, we just
+ assume that an otherwise unknown symbol is a variable. This sort
+ of thing commonly happens for symbols in module. */
+
+static void
+resolve_symbol (gfc_symbol * sym)
+{
+ /* Zero if we are checking a formal namespace. */
+ static int formal_ns_flag = 1;
+ int formal_ns_save, check_constant, mp_flag;
+ gfc_symtree *symtree;
+ gfc_symtree *this_symtree;
+ gfc_namespace *ns;
+ gfc_component *c;
+
+ if (sym->attr.flavor == FL_UNKNOWN)
+ {
+
+ /* If we find that a flavorless symbol is an interface in one of the
+ parent namespaces, find its symtree in this namespace, free the
+ symbol and set the symtree to point to the interface symbol. */
+ for (ns = gfc_current_ns->parent; ns; ns = ns->parent)
+ {
+ symtree = gfc_find_symtree (ns->sym_root, sym->name);
+ if (symtree && symtree->n.sym->generic)
+ {
+ this_symtree = gfc_find_symtree (gfc_current_ns->sym_root,
+ sym->name);
+ sym->refs--;
+ if (!sym->refs)
+ gfc_free_symbol (sym);
+ symtree->n.sym->refs++;
+ this_symtree->n.sym = symtree->n.sym;
+ return;
+ }
+ }
+
+ /* Otherwise give it a flavor according to such attributes as
+ it has. */
+ if (sym->attr.external == 0 && sym->attr.intrinsic == 0)
+ sym->attr.flavor = FL_VARIABLE;
+ else
+ {
+ sym->attr.flavor = FL_PROCEDURE;
+ if (sym->attr.dimension)
+ sym->attr.function = 1;
+ }
+ }
+
+ if (sym->attr.flavor == FL_DERIVED && resolve_fl_derived (sym) == FAILURE)
+ return;
+
+ /* Symbols that are module procedures with results (functions) have
+ the types and array specification copied for type checking in
+ procedures that call them, as well as for saving to a module
+ file. These symbols can't stand the scrutiny that their results
+ can. */
+ mp_flag = (sym->result != NULL && sym->result != sym);
+
+ /* Assign default type to symbols that need one and don't have one. */
+ if (sym->ts.type == BT_UNKNOWN)
+ {
+ if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER)
+ gfc_set_default_type (sym, 1, NULL);
+
+ if (sym->attr.flavor == FL_PROCEDURE && sym->attr.function)
+ {
+ /* The specific case of an external procedure should emit an error
+ in the case that there is no implicit type. */
+ if (!mp_flag)
+ gfc_set_default_type (sym, sym->attr.external, NULL);
+ else
+ {
+ /* Result may be in another namespace. */
+ resolve_symbol (sym->result);
+
+ sym->ts = sym->result->ts;
+ sym->as = gfc_copy_array_spec (sym->result->as);
+ sym->attr.dimension = sym->result->attr.dimension;
+ sym->attr.pointer = sym->result->attr.pointer;
+ sym->attr.allocatable = sym->result->attr.allocatable;
+ }
+ }
+ }
+
+ /* Assumed size arrays and assumed shape arrays must be dummy
+ arguments. */
+
+ if (sym->as != NULL
+ && (sym->as->type == AS_ASSUMED_SIZE
+ || sym->as->type == AS_ASSUMED_SHAPE)
+ && sym->attr.dummy == 0)
+ {
+ if (sym->as->type == AS_ASSUMED_SIZE)
+ gfc_error ("Assumed size array at %L must be a dummy argument",
+ &sym->declared_at);
+ else
+ gfc_error ("Assumed shape array at %L must be a dummy argument",
+ &sym->declared_at);
+ return;
+ }
+
+ /* Make sure symbols with known intent or optional are really dummy
+ variable. Because of ENTRY statement, this has to be deferred
+ until resolution time. */
+
+ if (!sym->attr.dummy
+ && (sym->attr.optional
+ || sym->attr.intent != INTENT_UNKNOWN))
+ {
+ gfc_error ("Symbol at %L is not a DUMMY variable", &sym->declared_at);
+ return;
+ }
+
+ /* If a derived type symbol has reached this point, without its
+ type being declared, we have an error. Notice that most
+ conditions that produce undefined derived types have already
+ been dealt with. However, the likes of:
+ implicit type(t) (t) ..... call foo (t) will get us here if
+ the type is not declared in the scope of the implicit
+ statement. Change the type to BT_UNKNOWN, both because it is so
+ and to prevent an ICE. */
+ if (sym->ts.type == BT_DERIVED
+ && sym->ts.derived->components == NULL)
+ {
+ gfc_error ("The derived type '%s' at %L is of type '%s', "
+ "which has not been defined.", sym->name,
+ &sym->declared_at, sym->ts.derived->name);
+ sym->ts.type = BT_UNKNOWN;
+ return;
+ }
+
+ /* An assumed-size array with INTENT(OUT) shall not be of a type for which
+ default initialization is defined (5.1.2.4.4). */
+ if (sym->ts.type == BT_DERIVED
+ && sym->attr.dummy
+ && sym->attr.intent == INTENT_OUT
+ && sym->as
+ && sym->as->type == AS_ASSUMED_SIZE)
+ {
+ for (c = sym->ts.derived->components; c; c = c->next)
+ {
+ if (c->initializer)
+ {
+ gfc_error ("The INTENT(OUT) dummy argument '%s' at %L is "
+ "ASSUMED SIZE and so cannot have a default initializer",
+ sym->name, &sym->declared_at);
+ return;
+ }
+ }
+ }
+
+ switch (sym->attr.flavor)
+ {
+ case FL_VARIABLE:
+ if (resolve_fl_variable (sym, mp_flag) == FAILURE)
+ return;
+ break;
+
+ case FL_PROCEDURE:
+ if (resolve_fl_procedure (sym, mp_flag) == FAILURE)
+ return;
+ break;
+
+ case FL_NAMELIST:
+ if (resolve_fl_namelist (sym) == FAILURE)
+ return;
+ break;
+
+ case FL_PARAMETER:
+ if (resolve_fl_parameter (sym) == FAILURE)
+ return;
+
+ break;
+
+ default:
+
+ break;
+ }
+
+ /* Make sure that intrinsic exist */
+ if (sym->attr.intrinsic