Lines Matching refs:sym
100 is_sym_host_assoc (gfc_symbol *sym, gfc_namespace *ns)
104 if (sym->ns == ns)
152 while (gen && strcmp (gen->sym->name, ifc->name) != 0)
185 static void resolve_symbol (gfc_symbol *sym);
191 resolve_procedure_interface (gfc_symbol *sym)
193 gfc_symbol *ifc = sym->ts.interface;
198 if (ifc == sym)
201 sym->name, &sym->declared_at);
204 if (!check_proc_interface (ifc, &sym->declared_at))
216 sym->ts = ifc->result->ts;
217 sym->attr.allocatable = ifc->result->attr.allocatable;
218 sym->attr.pointer = ifc->result->attr.pointer;
219 sym->attr.dimension = ifc->result->attr.dimension;
220 sym->attr.class_ok = ifc->result->attr.class_ok;
221 sym->as = gfc_copy_array_spec (ifc->result->as);
222 sym->result = sym;
226 sym->ts = ifc->ts;
227 sym->attr.allocatable = ifc->attr.allocatable;
228 sym->attr.pointer = ifc->attr.pointer;
229 sym->attr.dimension = ifc->attr.dimension;
230 sym->attr.class_ok = ifc->attr.class_ok;
231 sym->as = gfc_copy_array_spec (ifc->as);
233 sym->ts.interface = ifc;
234 sym->attr.function = ifc->attr.function;
235 sym->attr.subroutine = ifc->attr.subroutine;
237 sym->attr.pure = ifc->attr.pure;
238 sym->attr.elemental = ifc->attr.elemental;
239 sym->attr.contiguous = ifc->attr.contiguous;
240 sym->attr.recursive = ifc->attr.recursive;
241 sym->attr.always_explicit = ifc->attr.always_explicit;
242 sym->attr.ext_attr |= ifc->attr.ext_attr;
243 sym->attr.is_bind_c = ifc->attr.is_bind_c;
247 sym->ts.u.cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
248 if (sym->ts.u.cl->length && !sym->ts.u.cl->resolved
249 && !gfc_resolve_expr (sym->ts.u.cl->length))
271 gfc_symbol *sym;
276 sym = proc->result;
278 sym = proc;
281 || sym->attr.pointer || sym->attr.allocatable
282 || (sym->as && sym->as->rank != 0))
285 sym->attr.always_explicit = 1;
294 sym = f->sym;
296 if (sym == NULL)
309 else if (sym->attr.procedure && sym->attr.if_source != IFSRC_DECL
310 && !resolve_procedure_interface (sym))
313 if (strcmp (proc->name, sym->name) == 0)
316 "%qs at %L is not allowed", sym->name,
321 if (sym->attr.if_source != IFSRC_UNKNOWN)
322 gfc_resolve_formal_arglist (sym);
324 if (sym->attr.subroutine || sym->attr.external)
326 if (sym->attr.flavor == FL_UNKNOWN)
327 gfc_add_flavor (&sym->attr, FL_PROCEDURE, sym->name, &sym->declared_at);
331 if (sym->ts.type == BT_UNKNOWN && !proc->attr.intrinsic
332 && (!sym->attr.function || sym->result == sym))
333 gfc_set_default_type (sym, 1, sym->ns);
336 as = sym->ts.type == BT_CLASS && sym->attr.class_ok
337 ? CLASS_DATA (sym)->as : sym->as;
348 && ((sym->ts.type != BT_CLASS
349 && !(sym->attr.pointer || sym->attr.allocatable))
350 || (sym->ts.type == BT_CLASS
351 && !(CLASS_DATA (sym)->attr.class_pointer
352 || CLASS_DATA (sym)->attr.allocatable)))
353 && sym->attr.flavor != FL_PROCEDURE)
362 || sym->attr.pointer || sym->attr.allocatable || sym->attr.target
363 || (sym->ts.type == BT_CLASS && sym->attr.class_ok
364 && (CLASS_DATA (sym)->attr.class_pointer
365 || CLASS_DATA (sym)->attr.allocatable
366 || CLASS_DATA (sym)->attr.target))
367 || sym->attr.optional)
377 if (sym->attr.flavor == FL_UNKNOWN)
378 gfc_add_flavor (&sym->attr, FL_VARIABLE, sym->name, &sym->declared_at);
382 if (sym->attr.flavor == FL_PROCEDURE)
385 if (!gfc_pure (sym))
388 "also be PURE", sym->name, &sym->declared_at);
392 else if (!sym->attr.pointer)
394 if (proc->attr.function && sym->attr.intent != INTENT_IN)
396 if (sym->attr.value)
400 sym->name, proc->name, &sym->declared_at);
403 "be INTENT(IN) or VALUE", sym->name, proc->name,
404 &sym->declared_at);
407 if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN)
409 if (sym->attr.value)
412 "attribute but without INTENT", sym->name,
413 proc->name, &sym->declared_at);
417 "VALUE attribute", sym->name, proc->name,
418 &sym->declared_at);
423 if (sym->ts.type == BT_CLASS && sym->attr.intent == INTENT_OUT)
426 " may not be polymorphic", sym->name, proc->name,
427 &sym->declared_at);
434 if (sym->attr.flavor == FL_PROCEDURE)
436 if (!gfc_pure (sym))
439 else if (!sym->attr.pointer)
441 if (proc->attr.function && sym->attr.intent != INTENT_IN
442 && !sym->value)
445 if (proc->attr.subroutine && sym->attr.intent == INTENT_UNKNOWN
446 && !sym->value)
454 if (sym->attr.codimension
455 || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
456 && CLASS_DATA (sym)->attr.codimension))
459 "procedure", sym->name, &sym->declared_at);
463 if (sym->as || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
464 && CLASS_DATA (sym)->as))
467 "be scalar", sym->name, &sym->declared_at);
471 if (sym->attr.allocatable
472 || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
473 && CLASS_DATA (sym)->attr.allocatable))
476 "have the ALLOCATABLE attribute", sym->name,
477 &sym->declared_at);
481 if (sym->attr.pointer
482 || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
483 && CLASS_DATA (sym)->attr.class_pointer))
486 "have the POINTER attribute", sym->name,
487 &sym->declared_at);
491 if (sym->attr.flavor == FL_PROCEDURE)
494 "procedure %qs at %L", sym->name, proc->name,
495 &sym->declared_at);
500 if (sym->attr.intent == INTENT_UNKNOWN && !sym->attr.value)
504 "attribute", sym->name, proc->name,
505 &sym->declared_at);
513 if (sym->as != NULL)
518 "must be scalar", sym->name, proc->name,
523 if (sym->ts.type == BT_CHARACTER)
525 gfc_charlen *cl = sym->ts.u.cl;
530 sym->name, &sym->declared_at);
544 find_arglists (gfc_symbol *sym)
546 if (sym->attr.if_source == IFSRC_UNKNOWN || sym->ns != gfc_current_ns
547 || gfc_fl_struct (sym->attr.flavor) || sym->attr.intrinsic)
550 gfc_resolve_formal_arglist (sym);
568 resolve_contained_fntype (gfc_symbol *sym, gfc_namespace *ns)
572 if (sym && sym->attr.flavor == FL_PROCEDURE
573 && sym->ns->parent
574 && sym->ns->parent->proc_name
575 && sym->ns->parent->proc_name->attr.flavor == FL_PROCEDURE
576 && !strcmp (sym->name, sym->ns->parent->proc_name->name))
578 "encompassing procedure", sym->name, &sym->declared_at);
582 if (! sym || !(sym->attr.function || sym->attr.flavor == FL_VARIABLE)
583 || sym->attr.entry_master)
586 if (!sym->result)
590 if (sym->result->ts.type == BT_UNKNOWN && sym->result->ts.interface == NULL)
592 t = gfc_set_default_type (sym->result, 0, ns);
594 if (!t && !sym->result->attr.untyped)
596 if (sym->result == sym)
598 sym->name, &sym->declared_at);
599 else if (!sym->result->attr.proc_pointer)
601 "no IMPLICIT type", sym->result->name, sym->name,
602 &sym->result->declared_at);
603 sym->result->attr.untyped = 1;
614 if (sym->result->ts.type == BT_CHARACTER)
616 gfc_charlen *cl = sym->result->ts.u.cl;
617 if ((!cl || !cl->length) && !sym->result->ts.deferred)
630 sym->name, &sym->declared_at);
647 new_sym = new_args->sym;
651 if (new_sym == f->sym)
660 new_arglist->sym = new_sym;
677 if (f->sym == NULL)
682 if (new_args->sym == f->sym)
689 f->sym->attr.not_always_present = 1;
730 el->sym = ns->proc_name;
743 el->sym->ns = ns;
749 if (el->sym->ns->proc_name->attr.flavor == FL_MODULE
750 && el->sym->attr.mod_proc)
751 el->sym->ns = ns;
774 gfc_symbol *sym;
779 fas = ns->entries->sym->as;
780 fas = fas ? fas : ns->entries->sym->result->as;
781 fts = &ns->entries->sym->result->ts;
783 fts = gfc_get_default_type (ns->entries->sym->result->name, NULL);
786 ts = &el->sym->result->ts;
787 as = el->sym->as;
788 as = as ? as : el->sym->result->as;
790 ts = gfc_get_default_type (el->sym->result->name, NULL);
793 || (el->sym->result->attr.dimension
794 != ns->entries->sym->result->attr.dimension)
795 || (el->sym->result->attr.pointer
796 != ns->entries->sym->result->attr.pointer))
798 else if (as && fas && ns->entries->sym->result != el->sym->result
801 "array specifications", ns->entries->sym->name,
802 &ns->entries->sym->declared_at);
819 "string lengths", ns->entries->sym->name,
820 &ns->entries->sym->declared_at);
825 sym = ns->entries->sym->result;
828 if (sym->attr.dimension)
829 gfc_set_array_spec (proc, gfc_copy_array_spec (sym->as), NULL);
830 if (sym->attr.pointer)
840 sym = el->sym->result;
841 if (sym->attr.dimension)
845 "FUNCTION %s at %L", sym->name,
846 ns->entries->sym->name, &sym->declared_at);
849 "FUNCTION %s at %L", sym->name,
850 ns->entries->sym->name, &sym->declared_at);
852 else if (sym->attr.pointer)
856 "FUNCTION %s at %L", sym->name,
857 ns->entries->sym->name, &sym->declared_at);
860 "FUNCTION %s at %L", sym->name,
861 ns->entries->sym->name, &sym->declared_at);
865 ts = &sym->ts;
867 ts = gfc_get_default_type (sym->name, NULL);
872 sym = NULL;
877 sym = NULL;
881 sym = NULL;
885 sym = NULL;
889 sym = NULL;
894 if (sym)
898 "in FUNCTION %s at %L", sym->name,
899 gfc_typename (ts), ns->entries->sym->name,
900 &sym->declared_at);
903 "in FUNCTION %s at %L", sym->name,
904 gfc_typename (ts), ns->entries->sym->name,
905 &sym->declared_at);
916 merge_argument_lists (proc, el->sym->formal);
921 check_argument_lists (proc, el->sym->formal);
995 gfc_symbol *sym;
1086 gfc_find_symbol (common_root->name, gfc_current_ns, 0, &sym);
1087 if (sym == NULL)
1090 if (sym->attr.flavor == FL_PARAMETER)
1092 sym->name, &common_root->n.common->where, &sym->declared_at);
1094 if (sym->attr.external)
1096 sym->name, &common_root->n.common->where);
1098 if (sym->attr.intrinsic)
1100 sym->name, &common_root->n.common->where);
1101 else if (sym->attr.result
1102 || gfc_is_function_return_value (sym, gfc_current_ns))
1104 "that is also a function result", sym->name,
1106 else if (sym->attr.flavor == FL_PROCEDURE && sym->attr.proc != PROC_INTERNAL
1107 && sym->attr.proc != PROC_ST_FUNCTION)
1109 "that is also a global procedure", sym->name,
1139 resolve_contained_fntype (el->sym, child);
1228 static bool resolve_fl_derived0 (gfc_symbol *sym);
1229 static bool resolve_fl_struct (gfc_symbol *sym);
1279 comp = expr->ref->u.c.sym->components;
1361 && cons->expr->symtree->n.sym->attr.flavor == FL_PARAMETER)
1420 s2 = cons->expr->symtree->n.sym->result;
1421 name = cons->expr->symtree->n.sym->result->name;
1425 s2 = cons->expr->symtree->n.sym;
1426 name = cons->expr->symtree->n.sym->name;
1509 && (gfc_impure_variable (cons->expr->symtree->n.sym)
1533 was_declared (gfc_symbol *sym)
1537 a = sym->attr;
1539 if (!a.implicit_type && sym->ts.type != BT_UNKNOWN)
1555 generic_sym (gfc_symbol *sym)
1559 if (sym->attr.generic ||
1560 (sym->attr.intrinsic && gfc_generic_intrinsic (sym->name)))
1563 if (was_declared (sym) || sym->ns->parent == NULL)
1566 gfc_find_symbol (sym->name, sym->ns->parent, 1, &s);
1570 if (s == sym)
1583 specific_sym (gfc_symbol *sym)
1587 if (sym->attr.if_source == IFSRC_IFBODY
1588 || sym->attr.proc == PROC_MODULE
1589 || sym->attr.proc == PROC_INTERNAL
1590 || sym->attr.proc == PROC_ST_FUNCTION
1591 || (sym->attr.intrinsic && gfc_specific_intrinsic (sym->name))
1592 || sym->attr.external)
1595 if (was_declared (sym) || sym->ns->parent == NULL)
1598 gfc_find_symbol (sym->name, sym->ns->parent, 1, &s);
1610 procedure_kind (gfc_symbol *sym)
1612 if (generic_sym (sym))
1615 if (specific_sym (sym))
1627 check_assumed_size_reference (gfc_symbol *sym, gfc_expr *e)
1629 if (need_full_assumed_size || !(sym->as && sym->as->type == AS_ASSUMED_SIZE))
1640 "array %qs at %L", sym->name, &e->where);
1661 if (e->symtree && check_assumed_size_reference (e->symtree->n.sym, e))
1686 gfc_symbol *sym;
1689 sym = e->symtree->n.sym;
1691 for (p = sym->generic; p; p = p->next)
1692 if (strcmp (sym->name, p->sym->name) == 0)
1694 e->symtree = gfc_find_symtree (p->sym->ns->sym_root,
1695 sym->name);
1700 gfc_error ("%qs at %L is ambiguous", e->symtree->n.sym->name,
1705 "argument at %L", sym->name, &e->where);
1711 /* See if a call to sym could possibly be a not allowed RECURSION because of
1712 a missing RECURSIVE declaration. This means that either sym is the current
1713 context itself, or sym is the parent of a contained procedure calling its
1715 This also works if sym is an ENTRY. */
1718 is_illegal_recursion (gfc_symbol* sym, gfc_namespace* context)
1724 if (sym->attr.flavor == FL_PROGRAM
1725 || gfc_fl_struct (sym->attr.flavor))
1729 if (sym->attr.entry && sym->ns->entries)
1730 proc_sym = sym->ns->entries->sym;
1732 proc_sym = sym;
1734 /* If sym is RECURSIVE, all is well of course. */
1746 context_proc = (real_context->entries ? real_context->entries->sym
1762 /* A call from sym's body to itself is recursion, of course. */
1766 /* The same is true if context is a contained procedure and sym the
1773 parent_proc = (context->parent->entries ? context->parent->entries->sym
1788 gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc)
1793 if (sym->resolve_symbol_called >= 2)
1796 sym->resolve_symbol_called = 2;
1799 if (sym->from_intmod && sym->ts.type != BT_UNKNOWN)
1807 if (sym->intmod_sym_id && sym->attr.subroutine)
1809 gfc_isym_id id = gfc_isym_id_by_intmod_sym (sym);
1812 else if (sym->intmod_sym_id)
1814 gfc_isym_id id = gfc_isym_id_by_intmod_sym (sym);
1817 else if (!sym->attr.subroutine)
1818 isym = gfc_find_function (sym->name);
1820 if (isym && !sym->attr.subroutine)
1822 if (sym->ts.type != BT_UNKNOWN && warn_surprising
1823 && !sym->attr.implicit_type)
1826 " ignored", sym->name, &sym->declared_at);
1828 if (!sym->attr.function &&
1829 !gfc_add_function(&sym->attr, sym->name, loc))
1832 sym->ts = isym->ts;
1834 else if (isym || (isym = gfc_find_subroutine (sym->name)))
1836 if (sym->ts.type != BT_UNKNOWN && !sym->attr.implicit_type)
1839 " specifier", sym->name, &sym->declared_at);
1843 if (!sym->attr.subroutine &&
1844 !gfc_add_subroutine(&sym->attr, sym->name, loc))
1849 gfc_error ("%qs declared INTRINSIC at %L does not exist", sym->name,
1850 &sym->declared_at);
1854 gfc_copy_formal_args_intr (sym, isym, NULL);
1856 sym->attr.pure = isym->pure;
1857 sym->attr.elemental = isym->elemental;
1860 if (!gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at))
1866 sym->name, &sym->declared_at, symstd);
1880 gfc_symbol* sym;
1886 sym = expr->symtree->n.sym;
1888 if (sym->attr.intrinsic)
1889 gfc_resolve_intrinsic (sym, &expr->where);
1891 if (sym->attr.flavor != FL_PROCEDURE
1892 || (sym->attr.function && sym->result == sym))
1897 if (is_illegal_recursion (sym, gfc_current_ns))
1900 " %<-frecursive%>", sym->name, &expr->where);
1935 gfc_symbol *sym;
1966 && e->symtree->n.sym->attr.generic
1984 sym = e->symtree->n.sym;
1986 if (sym->attr.flavor == FL_PROCEDURE && is_dt_name (sym->name))
1989 "argument at %L", sym->name, &e->where);
1993 if (sym->attr.flavor == FL_PROCEDURE
1994 || sym->attr.intrinsic
1995 || sym->attr.external)
2001 if (gfc_is_intrinsic (sym, sym->attr.subroutine, e->where))
2002 sym->attr.intrinsic = 1;
2004 if (sym->attr.proc == PROC_ST_FUNCTION)
2007 "actual argument", sym->name, &e->where);
2010 actual_ok = gfc_intrinsic_actual_ok (sym->name,
2011 sym->attr.subroutine);
2012 if (sym->attr.intrinsic && actual_ok == 0)
2015 "actual argument", sym->name, &e->where);
2018 if (sym->attr.contained && !sym->attr.use_assoc
2019 && sym->ns->proc_name->attr.flavor != FL_MODULE)
2023 sym->name, &e->where))
2027 if (sym->attr.elemental && !sym->attr.intrinsic)
2030 "allowed as an actual argument at %L", sym->name,
2036 if (sym->attr.generic && count_specific_procs (e) != 1)
2040 sym = e->symtree->n.sym;
2045 if (gfc_is_function_return_value (sym, sym->ns))
2049 if (sym->ts.type == BT_UNKNOWN && sym->attr.intrinsic)
2053 isym = gfc_find_function (sym->name);
2057 "for the reference %qs at %L", sym->name,
2061 sym->ts = isym->ts;
2062 sym->attr.intrinsic = 1;
2063 sym->attr.function = 1;
2073 if (was_declared (sym) || sym->ns->parent == NULL)
2076 if (gfc_find_sym_tree (sym->name, sym->ns->parent, 1, &parent_st))
2078 gfc_error ("Symbol %qs at %L is ambiguous", sym->name, &e->where);
2085 sym = parent_st->n.sym;
2088 if (sym->attr.flavor == FL_PROCEDURE
2089 || sym->attr.intrinsic
2090 || sym->attr.external)
2099 e->ts = sym->ts;
2100 if ((sym->as != NULL && sym->ts.type != BT_CLASS)
2101 || (sym->ts.type == BT_CLASS && sym->attr.class_ok
2102 && CLASS_DATA (sym)->as))
2104 e->rank = sym->ts.type == BT_CLASS
2105 ? CLASS_DATA (sym)->as->rank : sym->as->rank;
2109 e->ref->u.ar.as = sym->ts.type == BT_CLASS
2110 ? CLASS_DATA (sym)->as : sym->as;
2164 if (e->symtree->n.sym->attr.proc == PROC_INTERNAL)
2248 esym = c->symtree->n.sym;
2264 && arg->expr->symtree->n.sym->attr.optional)
2296 if (eformal->sym && eformal->sym->attr.optional)
2311 && arg->expr->symtree->n.sym->attr.optional
2322 arg->expr->symtree->n.sym->name, &arg->expr->where);
2351 if ((eformal->sym->attr.intent == INTENT_OUT
2352 || eformal->sym->attr.intent == INTENT_INOUT)
2358 (eformal->sym->attr.intent == INTENT_OUT) ? "OUT"
2359 : "INOUT", eformal->sym->name, esym->name);
2382 not_in_recursive (gfc_symbol *sym, gfc_namespace *gsym_ns)
2387 if (sym->ns == gsym_ns)
2390 if (sym->ns->parent && sym->ns->parent == gsym_ns)
2397 not_entry_self_reference (gfc_symbol *sym, gfc_namespace *gsym_ns)
2405 if (strcmp (sym->name, entry->sym->name) == 0)
2408 sym->ns->proc_name->name) == 0)
2411 if (sym->ns->parent
2413 sym->ns->parent->proc_name->name) == 0)
2425 gfc_explicit_interface_required (gfc_symbol *sym, char *errmsg, int err_len)
2427 gfc_formal_arglist *arg = gfc_sym_get_dummy_args (sym);
2431 if (!arg->sym)
2434 if (arg->sym->attr.allocatable) /* (2a) */
2439 else if (arg->sym->attr.asynchronous)
2444 else if (arg->sym->attr.optional)
2449 else if (arg->sym->attr.pointer)
2454 else if (arg->sym->attr.target)
2459 else if (arg->sym->attr.value)
2464 else if (arg->sym->attr.volatile_)
2469 else if (arg->sym->as && arg->sym->as->type == AS_ASSUMED_SHAPE) /* (2b) */
2474 else if (arg->sym->as && arg->sym->as->type == AS_ASSUMED_RANK) /* TS 29113, 6.2. */
2479 else if (arg->sym->attr.codimension) /* (2c) */
2489 else if (arg->sym->ts.type == BT_CLASS) /* (2e) */
2494 else if (arg->sym->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK))
2499 else if (arg->sym->ts.type == BT_ASSUMED)
2508 if (sym->attr.function)
2510 gfc_symbol *res = sym->result ? sym->result : sym;
2531 if (sym->attr.elemental && !sym->attr.intrinsic) /* (4) */
2536 else if (sym->attr.is_bind_c) /* (5) */
2547 resolve_global_procedure (gfc_symbol *sym, locus *where, int sub)
2556 gsym = gfc_get_gsymbol (sym->binding_label ? sym->binding_label : sym->name,
2557 sym->binding_label != NULL);
2562 if ((sym->attr.if_source == IFSRC_UNKNOWN
2563 || sym->attr.if_source == IFSRC_IFBODY)
2568 && not_in_recursive (sym, gsym->ns)
2569 && not_entry_self_reference (sym, gsym->ns))
2619 if (strcmp (entry->sym->name, sym->name) == 0)
2621 def_sym = entry->sym;
2627 if (sym->attr.function && !gfc_compare_types (&sym->ts, &def_sym->ts))
2630 sym->name, &sym->declared_at, gfc_typename (&sym->ts),
2635 if (sym->attr.if_source == IFSRC_UNKNOWN
2639 sym->name, &sym->declared_at, reason);
2644 if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
2657 sym->name, &sym->declared_at, reason);
2681 resolve_generic_f0 (gfc_expr *expr, gfc_symbol *sym)
2685 if (sym->attr.generic)
2687 s = gfc_search_interface (sym->generic, 0, &expr->value.function.actual);
2712 if (sym->attr.intrinsic)
2722 gfc_symbol *sym;
2726 sym = expr->symtree->n.sym;
2730 m = resolve_generic_f0 (expr, sym);
2738 for (intr = sym->generic; intr; intr = intr->next)
2739 if (gfc_fl_struct (intr->sym->attr.flavor))
2742 if (sym->ns->parent == NULL)
2744 gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
2746 if (sym == NULL)
2748 if (!generic_sym (sym))
2754 if (sym && !intr && !gfc_is_intrinsic (sym, 0, expr->where))
2759 expr->symtree->n.sym->name, &expr->where);
2762 "at %L", expr->symtree->n.sym->name, &expr->where);
2768 if (!gfc_convert_to_structure_constructor (expr, intr->sym, NULL,
2782 "specific intrinsic interface", expr->symtree->n.sym->name,
2792 resolve_specific_f0 (gfc_symbol *sym, gfc_expr *expr)
2796 if (sym->attr.external || sym->attr.if_source == IFSRC_IFBODY)
2798 if (sym->attr.dummy)
2800 sym->attr.proc = PROC_DUMMY;
2804 sym->attr.proc = PROC_EXTERNAL;
2808 if (sym->attr.proc == PROC_MODULE
2809 || sym->attr.proc == PROC_ST_FUNCTION
2810 || sym->attr.proc == PROC_INTERNAL)
2813 if (sym->attr.intrinsic)
2820 "with an intrinsic", sym->name, &expr->where);
2828 gfc_procedure_use (sym, &expr->value.function.actual, &expr->where);
2830 if (sym->result)
2831 expr->ts = sym->result->ts;
2833 expr->ts = sym->ts;
2834 expr->value.function.name = sym->name;
2835 expr->value.function.esym = sym;
2836 /* Prevent crash when sym->ts.u.derived->components is not set due to previous
2838 if (sym->ts.type == BT_CLASS && !CLASS_DATA (sym))
2840 if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->as)
2841 expr->rank = CLASS_DATA (sym)->as->rank;
2842 else if (sym->as != NULL)
2843 expr->rank = sym->as->rank;
2852 gfc_symbol *sym;
2855 sym = expr->symtree->n.sym;
2859 m = resolve_specific_f0 (sym, expr);
2865 if (sym->ns->parent == NULL)
2868 gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
2870 if (sym == NULL)
2875 expr->symtree->n.sym->name, &expr->where);
2884 lookup_function_fuzzy_find_candidates (gfc_symtree *sym,
2890 if (sym == NULL)
2892 if ((sym->n.sym->ts.type != BT_UNKNOWN || sym->n.sym->attr.external)
2893 && sym->n.sym->attr.flavor == FL_PROCEDURE)
2894 vec_push (candidates, candidates_len, sym->name);
2896 p = sym->left;
2900 p = sym->right;
2923 gfc_symbol *sym;
2926 sym = expr->symtree->n.sym;
2928 if (sym->attr.dummy)
2930 sym->attr.proc = PROC_DUMMY;
2931 expr->value.function.name = sym->name;
2937 if (gfc_is_intrinsic (sym, 0, expr->where))
2946 sym->attr.proc = PROC_EXTERNAL;
2947 expr->value.function.name = sym->name;
2948 expr->value.function.esym = expr->symtree->n.sym;
2950 if (sym->as != NULL)
2951 expr->rank = sym->as->rank;
2957 gfc_procedure_use (sym, &expr->value.function.actual, &expr->where);
2959 if (sym->ts.type != BT_UNKNOWN)
2960 expr->ts = sym->ts;
2963 ts = gfc_get_default_type (sym->name, sym->ns);
2968 = gfc_lookup_function_fuzzy (sym->name, sym->ns->sym_root);
2972 sym->name, &expr->where, guessed);
2975 sym->name, &expr->where);
2988 is_external_proc (gfc_symbol *sym)
2990 if (!sym->attr.dummy && !sym->attr.contained
2991 && !gfc_is_intrinsic (sym, sym->attr.subroutine, sym->declared_at)
2992 && sym->attr.proc != PROC_ST_FUNCTION
2993 && !sym->attr.proc_pointer
2994 && !sym->attr.use_assoc
2995 && sym->name)
3017 && e->symtree->n.sym != NULL
3018 && e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION)
3019 return pure_stmt_function (e, e->symtree->n.sym);
3065 impure_stmt_fcn (gfc_expr *e, gfc_symbol *sym,
3074 || e->symtree->n.sym == sym
3075 || e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION)
3083 pure_stmt_function (gfc_expr *e, gfc_symbol *sym)
3085 return gfc_traverse_expr (e, sym, impure_stmt_fcn, 0) ? 0 : 1;
3127 update_current_proc_array_outer_dependency (gfc_symbol *sym)
3134 if (sibling->proc_name == sym)
3143 if ((sym->attr.array_outer_dependency || sym->attr.proc_pointer)
3156 gfc_symbol *sym;
3162 sym = NULL;
3164 sym = expr->symtree->n.sym;
3172 if (sym && sym->attr.intrinsic
3173 && (sym->intmod_sym_id == GFC_ISYM_CAF_GET
3174 || sym->intmod_sym_id == GFC_ISYM_CAF_SEND))
3179 gfc_error ("Unexpected junk after %qs at %L", expr->symtree->n.sym->name,
3184 if (sym && sym->attr.intrinsic
3185 && !gfc_resolve_intrinsic (sym, &expr->where))
3188 if (sym && (sym->attr.flavor == FL_VARIABLE || sym->attr.subroutine))
3190 gfc_error ("%qs at %L is not a function", sym->name, &expr->where);
3196 if (sym && sym->attr.abstract && !expr->value.function.esym)
3199 sym->name, &expr->where);
3205 if (sym && sym->attr.abstract && sym->attr.function
3206 && sym->result->ts.u.cl
3207 && sym->result->ts.u.cl->length == NULL
3208 && !sym->result->ts.deferred)
3211 "character length result (F2008: C418)", sym->name,
3212 &sym->declared_at);
3220 if (expr->symtree && expr->symtree->n.sym)
3221 p = expr->symtree->n.sym->attr.proc;
3225 no_formal_args = sym && is_external_proc (sym)
3226 && gfc_sym_get_dummy_args (sym) == NULL;
3241 if (sym && is_external_proc (sym))
3242 resolve_global_procedure (sym, &expr->where, 0);
3244 if (sym && sym->ts.type == BT_CHARACTER
3245 && sym->ts.u.cl
3246 && sym->ts.u.cl->length == NULL
3247 && !sym->attr.dummy
3248 && !sym->ts.deferred
3250 && !sym->attr.contained)
3255 sym->name, &expr->where);
3265 expr->ts = sym->ts;
3272 switch (procedure_kind (sym))
3381 esym->name, &expr->where, esym->ns->entries->sym->name);
3403 if (expr->symtree->n.sym->result
3404 && expr->symtree->n.sym->result->ts.type != BT_UNKNOWN
3405 && !expr->symtree->n.sym->result->attr.proc_pointer)
3406 expr->ts = expr->symtree->n.sym->result->ts;
3414 update_current_proc_array_outer_dependency (sym);
3427 pure_subroutine (gfc_symbol *sym, const char *name, locus *loc)
3429 if (gfc_pure (sym))
3456 resolve_generic_s0 (gfc_code *c, gfc_symbol *sym)
3460 if (sym->attr.generic)
3462 s = gfc_search_interface (sym->generic, 1, &c->ext.actual);
3474 if (sym->attr.intrinsic)
3484 gfc_symbol *sym;
3487 sym = c->symtree->n.sym;
3491 m = resolve_generic_s0 (c, sym);
3498 if (sym->ns->parent == NULL)
3500 gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
3502 if (sym == NULL)
3504 if (!generic_sym (sym))
3510 sym = c->symtree->n.sym;
3512 if (!gfc_is_intrinsic (sym, 1, c->loc))
3515 sym->name, &c->loc);
3524 "intrinsic subroutine interface", sym->name, &c->loc);
3533 resolve_specific_s0 (gfc_code *c, gfc_symbol *sym)
3537 if (sym->attr.external || sym->attr.if_source == IFSRC_IFBODY)
3539 if (sym->attr.dummy)
3541 sym->attr.proc = PROC_DUMMY;
3545 sym->attr.proc = PROC_EXTERNAL;
3549 if (sym->attr.proc == PROC_MODULE || sym->attr.proc == PROC_INTERNAL)
3552 if (sym->attr.intrinsic)
3559 "with an intrinsic", sym->name, &c->loc);
3567 gfc_procedure_use (sym, &c->ext.actual, &c->loc);
3569 c->resolved_sym = sym;
3570 if (!pure_subroutine (sym, sym->name, &c->loc))
3580 gfc_symbol *sym;
3583 sym = c->symtree->n.sym;
3587 m = resolve_specific_s0 (c, sym);
3593 if (sym->ns->parent == NULL)
3596 gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
3598 if (sym == NULL)
3602 sym = c->symtree->n.sym;
3604 sym->name, &c->loc);
3615 gfc_symbol *sym;
3617 sym = c->symtree->n.sym;
3619 if (sym->attr.dummy)
3621 sym->attr.proc = PROC_DUMMY;
3627 if (gfc_is_intrinsic (sym, 1, c->loc))
3637 gfc_procedure_use (sym, &c->ext.actual, &c->loc);
3639 c->resolved_sym = sym;
3641 return pure_subroutine (sym, sym->name, &c->loc);
3654 gfc_symbol *csym, *sym;
3657 csym = c->symtree ? c->symtree->n.sym : NULL;
3670 sym = st ? st->n.sym : NULL;
3671 if (sym && csym != sym
3672 && sym->ns == gfc_current_ns
3673 && sym->attr.flavor == FL_PROCEDURE
3674 && sym->attr.contained)
3676 sym->refs++;
3678 c->symtree->n.sym = sym;
3681 csym = c->symtree->n.sym;
3702 csym->name, &c->loc, csym->ns->entries->sym->name);
3859 if (!e->symtree || !e->symtree->n.sym)
3861 gfc_symbol *sym;
3863 sym = e->symtree->n.sym;
3864 sym->result = sym;
3865 sym->attr.flavor = FL_PROCEDURE;
3866 sym->attr.function = 1;
3867 sym->attr.elemental = 1;
3868 sym->attr.pure = 1;
3869 sym->attr.referenced = 1;
3870 gfc_intrinsic_symbol (sym);
3871 gfc_commit_symbol (sym);
4322 e->value.op.uop->op->sym->attr.referenced = 1;
4898 resolve_assoc_var (gfc_symbol* sym, bool resolve_target);
4908 if (e->symtree->n.sym->assoc)
4910 if (e->symtree->n.sym->assoc->target)
4911 gfc_resolve_expr (e->symtree->n.sym->assoc->target);
4912 resolve_assoc_var (e->symtree->n.sym, false);
4915 if (e->symtree->n.sym->ts.type == BT_CLASS)
4917 as = CLASS_DATA (e->symtree->n.sym)->as;
4921 as = e->symtree->n.sym->as;
4989 && e->symtree->n.sym->ts.type == BT_DERIVED)
5192 else if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.dummy)
5212 ts = &e->symtree->n.sym->ts;
5477 e->rank = ((e->symtree == NULL || e->symtree->n.sym->as == NULL)
5478 ? 0 : e->symtree->n.sym->as->rank);
5570 gfc_symbol *sym;
5577 sym = e->symtree->n.sym;
5581 if (sym->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK))
5586 "be used as actual argument", sym->name, &e->where);
5596 "as actual argument", sym->name, &e->where);
5607 sym->name, &e->where);
5612 else if (((sym->ts.type == BT_CLASS && sym->attr.class_ok
5613 && sym->ts.u.derived && CLASS_DATA (sym)
5614 && CLASS_DATA (sym)->as
5615 && CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
5616 || (sym->ts.type != BT_CLASS && sym->as
5617 && sym->as->type == AS_ASSUMED_RANK))
5618 && !sym->attr.select_rank_temporary)
5625 "actual argument", sym->name, &e->where);
5636 sym->name, &e->where);
5641 if ((sym->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) && e->ref
5646 "a subobject reference", sym->name, &e->ref->u.ar.where);
5655 "reference", sym->name, &e->ref->u.ar.where);
5660 if (((sym->ts.type == BT_CLASS && sym->attr.class_ok
5661 && sym->ts.u.derived && CLASS_DATA (sym)
5662 && CLASS_DATA (sym)->as
5663 && CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
5664 || (sym->ts.type != BT_CLASS && sym->as
5665 && sym->as->type == AS_ASSUMED_RANK))
5671 "reference", sym->name, &e->ref->u.ar.where);
5679 if (sym->assoc && e->rank == 0 && e->ref && sym->ts.type == BT_CLASS
5680 && sym->assoc->target && sym->assoc->target->ts.type == BT_CLASS
5681 && sym->assoc->target->ts.u.derived
5682 && CLASS_DATA (sym->assoc->target)
5683 && CLASS_DATA (sym->assoc->target)->as)
5691 ref->u.c.sym = sym->ts.u.derived;
5705 if (sym->assoc && !(sym->ts.type == BT_CLASS && e->rank == 0))
5707 if (sym->ts.type == BT_CLASS)
5709 if (!sym->attr.dimension && e->ref && e->ref->type == REF_ARRAY)
5711 else if (sym->attr.dimension && (!e->ref || e->ref->type != REF_ARRAY))
5720 if (sym->as)
5722 ref->u.ar.as = sym->as;
5723 ref->u.ar.dimen = sym->as->rank;
5731 if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.generic)
5732 sym->ts.u.derived = gfc_find_dt_in_generic (sym->ts.u.derived);
5736 if (sym->assoc && sym->attr.dimension && !e->ref)
5747 if (sym->assoc && sym->ts.type == BT_CLASS && sym->ts.u.derived
5748 && CLASS_DATA (sym)
5749 && CLASS_DATA (sym)->attr.dimension
5791 if (sym->attr.flavor == FL_PROCEDURE
5792 && (!sym->attr.function
5793 || (sym->attr.function && sym->result
5794 && sym->result->attr.proc_pointer
5795 && !sym->result->attr.function)))
5801 if (sym->ts.type != BT_UNKNOWN)
5803 else if (sym->attr.flavor == FL_PROCEDURE
5804 && sym->attr.function && sym->result
5805 && sym->result->ts.type != BT_UNKNOWN
5806 && sym->result->attr.proc_pointer)
5807 e->ts = sym->result->ts;
5811 if (!gfc_set_default_type (sym, 1, sym->ns))
5813 e->ts = sym->ts;
5816 if (check_assumed_size_reference (sym, e))
5822 && current_entry_id == sym->entry_id
5833 if (sym->attr.dummy && sym->ns == gfc_current_ns)
5840 for (formal = entry->sym->formal; formal; formal = formal->next)
5842 if (formal->sym && sym->name == formal->sym->name)
5856 sym->name, &cs_base->current->loc);
5860 sym->name, &cs_base->current->loc);
5868 if (sym->ts.type == BT_CHARACTER
5869 && !gfc_resolve_expr (sym->ts.u.cl->length))
5872 if (sym->as)
5873 for (n = 0; n < sym->as->rank; n++)
5875 if (!gfc_resolve_expr (sym->as->lower[n]))
5877 if (!gfc_resolve_expr (sym->as->upper[n]))
5884 sym->entry_id = current_entry_id + 1;
5889 if (sym->attr.flavor == FL_VARIABLE
5891 && (gfc_current_ns->parent == sym->ns
5893 && gfc_current_ns->parent->parent == sym->ns)))
5894 sym->attr.host_assoc = 1;
5897 && sym->attr.dimension
5898 && (sym->ns != gfc_current_ns
5899 || sym->attr.use_assoc
5900 || sym->attr.in_common))
5937 c = ref2 ? ref2->u.c.component : e->symtree->n.sym->components;
5958 if (e->rank == 0 && sym->as && sym->attr.flavor == FL_PARAMETER)
5978 gfc_symbol *sym, *old_sym;
5989 || e->symtree->n.sym == NULL
5993 old_sym = e->symtree->n.sym;
6000 gfc_find_symbol (e->symtree->name, gfc_current_ns, 1, &sym);
6002 if (sym && old_sym != sym
6003 && sym->ts.type == old_sym->ts.type
6004 && sym->attr.flavor == FL_PROCEDURE
6005 && sym->attr.contained)
6058 e->rank = sym->as ? sym->as->rank : 0;
6062 sym->refs++;
6460 declared = e->symtree->n.sym->ts.u.derived;
6502 target = g->specific->u.specific->n.sym;
6573 && c->expr1->value.compcall.tbp->u.specific->n.sym
6574 && c->expr1->value.compcall.tbp->u.specific->n.sym->attr.subroutine)
6652 if (e->value.compcall.tbp->u.specific->n.sym->as)
6653 e->rank = e->value.compcall.tbp->u.specific->n.sym->as->rank;
6663 e->value.function.esym = target->n.sym;
6666 e->ts = target->n.sym->ts;
6676 static bool resolve_fl_derived (gfc_symbol *sym);
6755 || (!class_ref && st->n.sym->ts.type != BT_CLASS))
6885 || (!class_ref && st->n.sym->ts.type != BT_CLASS))
6934 c->resolved_sym = c->expr1->symtree->n.sym;
7018 && (con->expr->symtree->n.sym->attr.flavor == FL_PARAMETER
7019 || con->expr->symtree->n.sym->attr.flavor == FL_VARIABLE))
7042 if (e->symtree->n.sym->ns->proc_name
7043 && e->symtree->n.sym->ns->proc_name->formal)
7044 s = e->symtree->n.sym->ns->proc_name->formal->sym;
7047 st = gfc_find_symtree (s->ns->sym_root, e->symtree->n.sym->name);
7050 && st->n.sym != NULL
7051 && st->n.sym->attr.dummy)
7081 && e->symtree->n.sym->attr.dummy)
7178 && e->symtree->n.sym->attr.select_rank_temporary
7179 && UNLIMITED_POLY (e->symtree->n.sym))
7332 forall_index (gfc_expr *expr, gfc_symbol *sym, int *f)
7340 if (expr->symtree->n.sym == sym)
7356 find_forall_index (gfc_expr *expr, gfc_symbol *sym, int f)
7358 if (gfc_traverse_expr (expr, sym, forall_index, f))
7416 if (find_forall_index (iter2->start, iter->var->symtree->n.sym, 0)
7417 || find_forall_index (iter2->end, iter->var->symtree->n.sym, 0)
7418 || find_forall_index (iter2->stride, iter->var->symtree->n.sym, 0))
7432 derived_inaccessible (gfc_symbol *sym)
7436 if (sym->attr.use_assoc && sym->attr.private_comp)
7439 for (c = sym->components; c; c = c->next)
7444 && sym == c->ts.u.derived)
7464 gfc_symbol *sym;
7474 sym = e->symtree->n.sym;
7475 unlimited = UNLIMITED_POLY(sym);
7477 if (sym->ts.type == BT_CLASS)
7479 allocatable = CLASS_DATA (sym)->attr.allocatable;
7480 pointer = CLASS_DATA (sym)->attr.class_pointer;
7484 allocatable = sym->attr.allocatable;
7485 pointer = sym->attr.pointer;
7548 /* Returns true if the expression e contains a reference to the symbol sym. */
7550 sym_in_expr (gfc_expr *e, gfc_symbol *sym, int *f ATTRIBUTE_UNUSED)
7552 if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym == sym)
7559 gfc_find_sym_in_expr (gfc_symbol *sym, gfc_expr *e)
7561 return gfc_traverse_expr (e, sym, sym_in_expr, 0);
7702 gfc_symbol *sym = NULL;
7724 sym = e->symtree->n.sym;
7742 if (sym->ts.type == BT_CLASS && CLASS_DATA (sym))
7744 allocatable = CLASS_DATA (sym)->attr.allocatable;
7745 pointer = CLASS_DATA (sym)->attr.class_pointer;
7746 dimension = CLASS_DATA (sym)->attr.dimension;
7747 codimension = CLASS_DATA (sym)->attr.codimension;
7748 is_abstract = CLASS_DATA (sym)->attr.abstract;
7752 allocatable = sym->attr.allocatable;
7753 pointer = sym->attr.pointer;
7754 dimension = sym->attr.dimension;
7755 codimension = sym->attr.codimension;
7887 "type-spec or source-expr", sym->name, &e->where);
7906 sym->name, &e->where);
8091 sym = a->expr->symtree->n.sym;
8094 if (gfc_bt_struct (sym->ts.type) || sym->ts.type == BT_CLASS)
8098 && gfc_find_sym_in_expr (sym, ar->start[i]))
8100 && gfc_find_sym_in_expr (sym, ar->end[i])))
8104 "itself allocated", sym->name, &ar->where);
8164 if (p->expr->symtree->n.sym->name == stat->symtree->n.sym->name)
8214 if (p->expr->symtree->n.sym->name == errmsg->symtree->n.sym->name)
8248 if (pe->symtree->n.sym->name == qe->symtree->n.sym->name)
8905 gfc_type_is_extensible (gfc_symbol *sym)
8907 return !(sym->attr.is_bind_c || sym->attr.sequence
8908 || (sym->attr.is_class
8909 && sym->components->ts.u.derived->attr.unlimited_polymorphic));
8920 resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
8924 gcc_assert (sym->assoc);
8925 gcc_assert (sym->attr.flavor == FL_VARIABLE);
8930 target = sym->assoc->target;
8933 gcc_assert (!sym->assoc->dangling);
8944 tsym = target->symtree->n.sym;
8966 for (gfc_namespace *ns = sym->ns; ns; ns = ns->parent)
8980 sym->attr.asynchronous = tsym->attr.asynchronous;
8981 sym->attr.volatile_ = tsym->attr.volatile_;
8983 sym->attr.target = tsym->attr.target
8986 sym->attr.subref_array_pointer = 1;
9009 if (sym->ts.type == BT_UNKNOWN)
9010 sym->ts = target->ts;
9012 gcc_assert (sym->ts.type != BT_UNKNOWN);
9015 sym->assoc->variable = (target->expr_type == EXPR_VARIABLE
9019 if (sym->attr.dimension && target->rank == 0)
9023 if (sym->ts.type != BT_CHARACTER)
9025 sym->name, &sym->declared_at);
9026 sym->attr.dimension = 0;
9043 if (target->rank != 0 && !sym->attr.select_rank_temporary)
9048 if (sym->ts.type != BT_CLASS && (!sym->as || sym->assoc->rankguessed))
9050 if (!sym->as)
9051 sym->as = gfc_get_array_spec ();
9052 as = sym->as;
9056 sym->attr.dimension = 1;
9058 sym->attr.codimension = 1;
9060 else if (sym->ts.type == BT_CLASS
9061 && CLASS_DATA (sym)
9062 && (!CLASS_DATA (sym)->as || sym->assoc->rankguessed))
9064 if (!CLASS_DATA (sym)->as)
9065 CLASS_DATA (sym)->as = gfc_get_array_spec ();
9066 as = CLASS_DATA (sym)->as;
9070 CLASS_DATA (sym)->attr.dimension = 1;
9072 CLASS_DATA (sym)->attr.codimension = 1;
9075 else if (!sym->attr.select_rank_temporary)
9077 /* target's rank is 0, but the type of the sym is still array valued,
9079 if (sym->ts.type == BT_CLASS && sym->ts.u.derived
9080 && CLASS_DATA (sym) && CLASS_DATA (sym)->as)
9110 sym->ts = *ts;
9111 sym->ts.type = BT_CLASS;
9112 attr = CLASS_DATA (sym) ? CLASS_DATA (sym)->attr : sym->attr;
9117 if (!gfc_build_class_symbol (&sym->ts, &attr, &as))
9120 c = gfc_find_component (sym->ts.u.derived, "_vptr", true, true, NULL);
9122 c->ts.u.derived = gfc_find_derived_vtab (sym->ts.u.derived);
9123 CLASS_DATA (sym)->attr.pointer = 1;
9124 CLASS_DATA (sym)->attr.class_pointer = 1;
9125 gfc_set_sym_referenced (sym->ts.u.derived);
9126 gfc_commit_symbol (sym->ts.u.derived);
9136 sym->attr.associate_var = 1;
9139 if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary)
9141 if (!sym->ts.u.cl)
9142 sym->ts.u.cl = target->ts.u.cl;
9144 if (sym->ts.deferred
9145 && sym->ts.u.cl == target->ts.u.cl)
9147 sym->ts.u.cl = gfc_new_charlen (sym->ns, NULL);
9148 sym->ts.deferred = 1;
9151 if (!sym->ts.u.cl->length
9152 && !sym->ts.deferred
9155 sym->ts.u.cl->length =
9159 else if ((!sym->ts.u.cl->length
9160 || sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
9163 if (!sym->ts.deferred)
9165 sym->ts.u.cl = gfc_new_charlen (sym->ns, NULL);
9166 sym->ts.deferred = 1;
9171 sym->attr.allocatable = 1;
9176 if (sym->ts.type == BT_CLASS && gfc_expr_attr (target).class_ok)
9177 sym->attr.class_ok = 1;
9192 gfc_symbol *sym1 = (*expr1)->symtree->n.sym;
9193 gfc_symbol *sym2 = expr2 ? expr2->symtree->n.sym : NULL;
9230 loc_call->symtree->n.sym->attr.flavor = FL_PROCEDURE;
9231 loc_call->symtree->n.sym->attr.intrinsic = 1;
9232 loc_call->symtree->n.sym->result = loc_call->symtree->n.sym;
9233 gfc_commit_symbol (loc_call->symtree->n.sym);
9272 if (!code->expr1->symtree->n.sym->attr.class_ok)
9285 if (code->expr1->symtree->n.sym->attr.untyped)
9286 code->expr1->symtree->n.sym->ts = ref2->u.c.component->ts;
9291 if (code->expr1->symtree->n.sym->attr.untyped)
9292 code->expr1->symtree->n.sym->ts = code->expr2->ts;
9428 code->expr1->symtree->n.sym->assoc = assoc;
9430 resolve_assoc_var (code->expr1->symtree->n.sym, false);
9546 gcc_assert (st->n.sym->assoc);
9547 st->n.sym->assoc->target = gfc_get_variable_expr (selector_expr->symtree);
9548 st->n.sym->assoc->target->where = selector_expr->where;
9551 gfc_add_data_component (st->n.sym->assoc->target);
9554 fixup_array_ref (&st->n.sym->assoc->target, NULL, rank, ref);
9565 if (st->n.sym->assoc->dangling)
9567 new_st->ext.block.assoc = st->n.sym->assoc;
9568 st->n.sym->assoc->dangling = 0;
9571 resolve_assoc_var (st->n.sym, false);
9691 it requires that the sym->assoc of selectors is set already. */
9731 code->expr1->symtree->n.sym->assoc = assoc;
9733 resolve_assoc_var (code->expr1->symtree->n.sym, false);
9842 gcc_assert (st->n.sym->assoc);
9844 st->n.sym->assoc->target = gfc_get_variable_expr (selector_expr->symtree);
9845 st->n.sym->assoc->target->where = selector_expr->where;
9855 if (st->n.sym->assoc->dangling)
9857 new_st->ext.block.assoc = st->n.sym->assoc;
9858 st->n.sym->assoc->dangling = 0;
9861 resolve_assoc_var (st->n.sym, false);
9879 gfc_symbol *sym, *derived;
9916 ? &exp->ts : &exp->symtree->n.sym->ts;
9939 sym = exp->symtree->n.sym->ns->proc_name;
9942 if (sym && sym == dtio_sub && sym->formal
9943 && sym->formal->sym == exp->symtree->n.sym
9946 if (!sym->attr.recursive)
9949 sym->name, &sym->declared_at);
10014 sym = exp->symtree->n.sym;
10016 if (sym->as != NULL && sym->as->type == AS_ASSUMED_SIZE && exp->ref
10157 lock_type = symtree->n.sym;
10163 lock_type = symtree->n.sym;
10174 code->resolved_sym = symtree->n.sym;
10175 symtree->n.sym->attr.flavor = FL_VARIABLE;
10176 symtree->n.sym->attr.referenced = 1;
10177 symtree->n.sym->attr.artificial = 1;
10178 symtree->n.sym->attr.codimension = 1;
10179 symtree->n.sym->ts.type = BT_DERIVED;
10180 symtree->n.sym->ts.u.derived = lock_type;
10181 symtree->n.sym->as = gfc_get_array_spec ();
10182 symtree->n.sym->as->corank = 1;
10183 symtree->n.sym->as->type = AS_EXPLICIT;
10184 symtree->n.sym->as->cotype = AS_EXPLICIT;
10185 symtree->n.sym->as->lower[0] = gfc_get_int_expr (gfc_default_integer_kind,
10459 forall_index = var_expr[n]->symtree->n.sym;
10464 && (code->expr1->symtree->n.sym == forall_index))
10651 if (fa->var->symtree->n.sym == var_expr[i]->symtree->n.sym)
10881 && (*rhsptr)->symtree->n.sym->ts.type == BT_DERIVED
10882 && gfc_has_default_initializer ((*rhsptr)->symtree->n.sym->ts.u.derived)
10883 && (lhs->symtree->n.sym == (*rhsptr)->symtree->n.sym))
10961 && gfc_find_sym_in_expr (lhs->symtree->n.sym,
10974 && (gfc_impure_variable (rhs->symtree->n.sym)
11006 && lhs->symtree->n.sym != gfc_current_ns->proc_name
11007 && lhs->symtree->n.sym->ns != gfc_current_ns)
11014 && (gfc_impure_variable (rhs->symtree->n.sym)
11097 code->resolved_sym = code->symtree->n.sym;
11126 (*ref)->u.c.sym = e->ts.u.derived;
11178 gfc_add_type (tmp->n.sym, &e->ts, NULL);
11181 tmp->n.sym->ts.u.cl->length = gfc_get_int_expr (gfc_charlen_int_kind,
11196 && e->symtree->n.sym->as == aref->as)
11211 tmp->n.sym->attr = gfc_expr_attr (e);
11212 tmp->n.sym->attr.function = 0;
11213 tmp->n.sym->attr.result = 0;
11214 tmp->n.sym->attr.flavor = FL_VARIABLE;
11215 tmp->n.sym->attr.dummy = 0;
11216 tmp->n.sym->attr.intent = INTENT_UNKNOWN;
11220 tmp->n.sym->as = gfc_copy_array_spec (as);
11224 tmp->n.sym->attr.allocatable = 1;
11230 tmp->n.sym->as = gfc_get_array_spec ();
11231 tmp->n.sym->as->type = AS_DEFERRED;
11232 tmp->n.sym->as->rank = e->rank;
11233 tmp->n.sym->attr.allocatable = 1;
11234 tmp->n.sym->attr.dimension = 1;
11237 tmp->n.sym->attr.dimension = 0;
11239 gfc_set_sym_referenced (tmp->n.sym);
11240 gfc_commit_symbol (tmp->n.sym);
11241 e = gfc_lval_expr_from_sym (tmp->n.sym);
11402 if ((*code)->expr1->symtree->n.sym->name[2] != '@')
11461 && dummy_args->sym->attr.intent == INTENT_INOUT)
11478 if ((*code)->expr1->symtree->n.sym->attr.allocatable)
11482 gfc_lval_expr_from_sym ((*code)->expr1->symtree->n.sym);
11504 if ((*code)->expr1->symtree->n.sym->attr.allocatable
11560 if (t1 && (*code)->expr1->symtree->n.sym->attr.allocatable
11567 e = gfc_lval_expr_from_sym ((*code)->expr1->symtree->n.sym);
11624 s = (*code)->expr1->symtree->n.sym;
11640 tmp_ptr_expr->symtree->n.sym->attr.pointer = 1;
11641 tmp_ptr_expr->symtree->n.sym->attr.allocatable = 0;
11684 tmp_expr->symtree->n.sym->ts.u.cl = tmp_expr->ts.u.cl;
11688 tmp_expr->symtree->n.sym->ts.deferred = 1;
11880 || (code->expr1->symtree->n.sym
11881 && (code->expr1->symtree->n.sym->attr.flavor
11885 else if (code->expr1->symtree->n.sym
11886 && code->expr1->symtree->n.sym->attr.assign != 1)
11888 "label at %L", code->expr1->symtree->n.sym->name,
11959 || code->expr1->symtree->n.sym->ts.type != BT_INTEGER
11960 || code->expr1->symtree->n.sym->ts.kind
11962 || code->expr1->symtree->n.sym->as != NULL))
11997 && code->expr2->symtree->n.sym->attr.flavor
12067 gfc_resolve_do_iterator (code, iter->var->symtree->n.sym,
12256 resolve_values (gfc_symbol *sym)
12260 if (sym->value == NULL)
12263 if (sym->value->expr_type == EXPR_STRUCTURE)
12264 t= resolve_structure_cons (sym->value, 1);
12266 t = gfc_resolve_expr (sym->value);
12271 gfc_check_assign_symbol (sym, NULL, sym->value);
12290 type 'sym'. These procedures can either have typebound bindings or
12294 gfc_verify_DTIO_procedures (gfc_symbol *sym)
12296 if (!sym || sym->attr.flavor != FL_DERIVED)
12299 gfc_check_dtio_interfaces (sym);
12309 gfc_verify_binding_labels (gfc_symbol *sym)
12314 if (!sym || !sym->attr.is_bind_c || sym->attr.is_iso_c
12315 || sym->attr.flavor == FL_DERIVED || !sym->binding_label)
12318 gsym = gfc_find_case_gsymbol (gfc_gsym_root, sym->binding_label);
12320 if (sym->module)
12321 module = sym->module;
12322 else if (sym->ns && sym->ns->proc_name
12323 && sym->ns->proc_name->attr.flavor == FL_MODULE)
12324 module = sym->ns->proc_name->name;
12325 else if (sym->ns && sym->ns->parent
12326 && sym->ns && sym->ns->parent->proc_name
12327 && sym->ns->parent->proc_name->attr.flavor == FL_MODULE)
12328 module = sym->ns->parent->proc_name->name;
12337 gsym = gfc_get_gsymbol (sym->binding_label, true);
12338 gsym->where = sym->declared_at;
12339 gsym->sym_name = sym->name;
12340 gsym->binding_label = sym->binding_label;
12341 gsym->ns = sym->ns;
12343 if (sym->attr.function)
12345 else if (sym->attr.subroutine)
12348 gsym->defined = sym->attr.if_source != IFSRC_IFBODY;
12352 if (sym->attr.flavor == FL_VARIABLE && gsym->type != GSYM_UNKNOWN)
12355 "identifier as entity at %L", sym->name,
12356 sym->binding_label, &sym->declared_at, &gsym->where);
12358 sym->binding_label = NULL;
12362 if (sym->attr.flavor == FL_VARIABLE && module
12364 || strcmp (sym->name, gsym->sym_name) != 0))
12370 sym->name, module, sym->binding_label,
12371 &sym->declared_at, &gsym->where, gsym->mod_name);
12372 sym->binding_label = NULL;
12376 if ((sym->attr.function || sym->attr.subroutine)
12378 || (gsym->defined && sym->attr.if_source != IFSRC_IFBODY))
12379 && (sym != gsym->ns->proc_name && sym->attr.entry == 0)
12381 || strcmp (gsym->sym_name, sym->name) != 0
12388 "global identifier as entity at %L", sym->name,
12389 sym->binding_label, &sym->declared_at, &gsym->where);
12390 sym->binding_label = NULL;
12486 is_non_constant_shape_array (gfc_symbol *sym)
12493 if (sym->as != NULL)
12498 for (i = 0; i < sym->as->rank + sym->as->corank; i++)
12503 e = sym->as->lower[i];
12507 e = sym->as->upper[i];
12519 build_init_assign (gfc_symbol *sym, gfc_expr *init)
12523 gfc_namespace *ns = sym->ns;
12527 if (sym->attr.function && sym == sym->result
12528 && sym->name != sym->ns->proc_name->name)
12532 if (strcmp (ns->proc_name->name, sym->name) == 0)
12543 lval = gfc_lval_expr_from_sym (sym);
12551 init_st->loc = sym->declared_at;
12560 can_generate_init (gfc_symbol *sym)
12563 if (!sym)
12565 a = &sym->attr;
12572 || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
12573 && (CLASS_DATA (sym)->attr.class_pointer
12574 || CLASS_DATA (sym)->attr.proc_pointer))
12578 || sym->module
12581 || sym->assoc
12584 || (a->function && sym != sym->result)
12592 apply_default_init (gfc_symbol *sym)
12596 if (sym->attr.flavor != FL_VARIABLE && !sym->attr.function)
12599 if (sym->ts.type == BT_DERIVED && sym->ts.u.derived)
12600 init = gfc_generate_initializer (&sym->ts, can_generate_init (sym));
12602 if (init == NULL && sym->ts.type != BT_CLASS)
12605 build_init_assign (sym, init);
12606 sym->attr.referenced = 1;
12614 build_default_init_expr (gfc_symbol *sym)
12617 if (sym->attr.allocatable
12618 || sym->attr.external
12619 || sym->attr.dummy
12620 || sym->attr.pointer
12621 || sym->attr.in_equivalence
12622 || sym->attr.in_common
12623 || sym->attr.data
12624 || sym->module
12625 || sym->attr.cray_pointee
12626 || sym->attr.cray_pointer
12627 || sym->assoc)
12631 return gfc_build_default_init_expr (&sym->ts, &sym->declared_at);
12636 apply_default_init_local (gfc_symbol *sym)
12641 if ((sym->attr.flavor != FL_VARIABLE && !sym->attr.function)
12642 || (sym->attr.function && sym->result != sym))
12647 init = build_default_init_expr (sym);
12655 if (!sym->attr.automatic
12656 && (sym->attr.save || sym->ns->save_all
12657 || (flag_max_stack_var_size == 0 && !sym->attr.result
12658 && (sym->ns->proc_name && !sym->ns->proc_name->attr.recursive)
12659 && (!sym->attr.dimension || !is_non_constant_shape_array (sym)))))
12662 gcc_assert (sym->value == NULL);
12663 sym->value = init;
12667 build_init_assign (sym, init);
12674 resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
12678 if (sym->ts.type == BT_CLASS && sym->attr.class_ok
12679 && sym->ts.u.derived && CLASS_DATA (sym))
12680 as = CLASS_DATA (sym)->as;
12682 as = sym->as;
12689 if (sym->ts.type == BT_CLASS && sym->attr.class_ok
12690 && sym->ts.u.derived && CLASS_DATA (sym))
12692 pointer = CLASS_DATA (sym)->attr.class_pointer;
12693 allocatable = CLASS_DATA (sym)->attr.allocatable;
12694 dimension = CLASS_DATA (sym)->attr.dimension;
12698 pointer = sym->attr.pointer && !sym->attr.select_type_temporary;
12699 allocatable = sym->attr.allocatable;
12700 dimension = sym->attr.dimension;
12708 "shape or assumed rank", sym->name, &sym->declared_at);
12713 sym->name, &sym->declared_at))
12720 "assumed rank", sym->name, &sym->declared_at);
12721 sym->error = 1;
12727 if (!mp_flag && !sym->attr.allocatable && !sym->attr.pointer
12728 && sym->ts.type != BT_CLASS && !sym->assoc)
12731 sym->name, &sym->declared_at);
12737 if (sym->ts.type == BT_CLASS && !(sym->result && sym->result != sym))
12740 if (sym->attr.class_ok
12741 && sym->ts.u.derived
12742 && !sym->attr.select_type_temporary
12743 && !UNLIMITED_POLY (sym)
12744 && !gfc_type_is_extensible (CLASS_DATA (sym)->ts.u.derived))
12747 CLASS_DATA (sym)->ts.u.derived->name, sym->name,
12748 &sym->declared_at);
12756 if (!sym->attr.class_ok && !sym->attr.use_assoc && !sym->assoc)
12759 "or pointer", sym->name, &sym->declared_at);
12772 resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
12774 gcc_assert (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS);
12780 if (sym->ts.u.derived
12781 && sym->ns != sym->ts.u.derived->ns
12782 && !sym->ts.u.derived->attr.use_assoc
12783 && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY)
12786 gfc_find_symbol (sym->ts.u.derived->name, sym->ns, 0, &s);
12794 sym->ts.u.derived->name, &sym->declared_at,
12808 if (!(sym->value || no_init_flag) && sym->ns->proc_name
12809 && sym->ns->proc_name->attr.flavor == FL_MODULE
12810 && !(sym->ns->save_all && !sym->attr.automatic) && !sym->attr.save
12811 && !sym->attr.pointer && !sym->attr.allocatable
12812 && gfc_has_default_initializer (sym->ts.u.derived)
12815 "initialization", sym->name, &sym->declared_at))
12819 if (!(sym->value || sym->attr.pointer || sym->attr.allocatable)
12820 && (!no_init_flag || sym->attr.intent == INTENT_OUT))
12821 sym->value = gfc_generate_initializer (&sym->ts, can_generate_init (sym));
12832 deferred_requirements (gfc_symbol *sym)
12834 if (sym->ts.deferred
12835 && !(sym->attr.pointer
12836 || sym->attr.allocatable
12837 || sym->attr.associate_var
12838 || sym->attr.omp_udr_artificial_var))
12841 if (sym->result && sym->name != sym->result->name)
12846 sym->name, &sym->declared_at);
12856 resolve_fl_variable (gfc_symbol *sym, int mp_flag)
12861 if (!resolve_fl_var_and_proc (sym, mp_flag))
12870 if (sym->ns->proc_name
12871 && (sym->ns->proc_name->attr.flavor == FL_MODULE
12872 || sym->ns->proc_name->attr.is_main_program)
12873 && !sym->attr.use_assoc
12874 && !sym->attr.allocatable
12875 && !sym->attr.pointer
12876 && is_non_constant_shape_array (sym))
12881 "have constant shape", sym->name, &sym->declared_at);
12887 if (!deferred_requirements (sym))
12890 if (sym->ts.type == BT_CHARACTER && !sym->attr.associate_var)
12896 if (sym->ts.u.cl)
12897 e = sym->ts.u.cl->length;
12901 if (e == NULL && !sym->attr.dummy && !sym->attr.result
12902 && !sym->ts.deferred && !sym->attr.select_type_temporary
12903 && !sym->attr.omp_udr_artificial_var)
12906 "dummy argument or a PARAMETER", &sym->declared_at);
12911 if (e && sym->attr.save == SAVE_EXPLICIT && !gfc_is_constant_expr (e))
12913 gfc_error (auto_save_msg, sym->name, &sym->declared_at);
12920 && e->symtree->n.sym->attr.flavor == FL_PARAMETER))
12922 if (!sym->attr.use_assoc && sym->ns->proc_name
12923 && (sym->ns->proc_name->attr.flavor == FL_MODULE
12924 || sym->ns->proc_name->attr.is_main_program))
12927 "in this context", sym->name, &sym->declared_at);
12931 if (sym->attr.in_common)
12934 "character length", sym->name, &sym->declared_at);
12941 if (sym->value == NULL && sym->attr.referenced)
12942 apply_default_init_local (sym); /* Try to apply a default initialization. */
12946 if (sym->attr.allocatable || sym->attr.external || sym->attr.dummy
12947 || sym->attr.intrinsic || sym->attr.result)
12949 else if ((sym->attr.dimension || sym->attr.codimension) && !sym->attr.pointer
12950 && is_non_constant_shape_array (sym))
12956 if (sym->as && sym->attr.codimension)
12958 int corank = sym->as->corank;
12959 sym->as->corank = 0;
12960 no_init_flag = automatic_flag = is_non_constant_shape_array (sym);
12961 sym->as->corank = corank;
12963 if (automatic_flag && sym->attr.save == SAVE_EXPLICIT)
12965 gfc_error (auto_save_msg, sym->name, &sym->declared_at);
12972 if (sym->value)
12973 gfc_simplify_expr (sym->value, 1);
12976 if (!sym->mark && sym->value)
12978 if (sym->attr.allocatable || (sym->ts.type == BT_CLASS
12979 && CLASS_DATA (sym)->attr.allocatable))
12981 sym->name, &sym->declared_at);
12982 else if (sym->attr.external)
12984 sym->name, &sym->declared_at);
12985 else if (sym->attr.dummy
12986 && !(sym->ts.type == BT_DERIVED && sym->attr.intent == INTENT_OUT))
12988 sym->name, &sym->declared_at);
12989 else if (sym->attr.intrinsic)
12991 sym->name, &sym->declared_at);
12992 else if (sym->attr.result)
12994 sym->name, &sym->declared_at);
12997 sym->name, &sym->declared_at);
13005 if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
13007 bool res = resolve_fl_variable_derived (sym, no_init_flag);
13023 compare_fsyms (gfc_symbol *sym)
13027 if (sym == NULL || new_formal == NULL)
13030 fsym = new_formal->sym;
13032 if (sym == fsym)
13035 if (strcmp (sym->name, fsym->name) == 0)
13037 if (!gfc_check_dummy_characteristics (fsym, sym, true, errmsg, 200))
13046 resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
13051 if (sym->attr.function
13052 && !resolve_fl_var_and_proc (sym, mp_flag))
13056 if (!deferred_requirements (sym))
13059 if (sym->ts.type == BT_CHARACTER)
13061 gfc_charlen *cl = sym->ts.u.cl;
13068 && sym->attr.proc == PROC_ST_FUNCTION)
13071 "have constant length", sym->name, &sym->declared_at);
13080 if (!(sym->ns->parent && sym->ns->parent->proc_name
13081 && sym->ns->parent->proc_name->attr.flavor == FL_MODULE)
13082 && gfc_check_symbol_access (sym))
13086 for (arg = gfc_sym_get_dummy_args (sym); arg; arg = arg->next)
13088 if (arg->sym
13089 && arg->sym->ts.type == BT_DERIVED
13090 && arg->sym->ts.u.derived
13091 && !arg->sym->ts.u.derived->attr.use_assoc
13092 && !gfc_check_symbol_access (arg->sym->ts.u.derived)
13096 arg->sym->name, sym->name,
13097 &sym->declared_at))
13100 arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC;
13107 for (iface = sym->generic; iface; iface = iface->next)
13109 for (arg = gfc_sym_get_dummy_args (iface->sym); arg; arg = arg->next)
13111 if (arg->sym
13112 && arg->sym->ts.type == BT_DERIVED
13113 && !arg->sym->ts.u.derived->attr.use_assoc
13114 && !gfc_check_symbol_access (arg->sym->ts.u.derived)
13118 "is PRIVATE", iface->sym->name,
13119 sym->name, &iface->sym->declared_at,
13120 gfc_typename(&arg->sym->ts)))
13123 arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC;
13130 if (sym->attr.function && sym->value && sym->attr.proc != PROC_ST_FUNCTION
13131 && !sym->attr.proc_pointer)
13134 sym->name, &sym->declared_at);
13137 sym->value->error = 1;
13143 if (sym->attr.external && sym->value && !sym->attr.proc_pointer)
13146 sym->name, &sym->declared_at);
13151 if (sym->attr.elemental && sym->attr.function
13152 && (sym->as || (sym->ts.type == BT_CLASS && sym->attr.class_ok
13153 && CLASS_DATA (sym)->as)))
13156 "result", sym->name, &sym->declared_at);
13158 sym->attr.elemental = 0;
13162 if (sym->attr.proc == PROC_ST_FUNCTION
13163 && (sym->attr.allocatable || sym->attr.pointer))
13166 "allocatable attribute", sym->name, &sym->declared_at);
13176 if (sym->attr.function
13177 && sym->ts.type == BT_CHARACTER && !sym->ts.deferred
13178 && sym->ts.u.cl && sym->ts.u.cl->length == NULL)
13180 if ((sym->as && sym->as->rank) || (sym->attr.pointer)
13181 || (sym->attr.recursive) || (sym->attr.pure))
13183 if (sym->as && sym->as->rank)
13185 "array-valued", sym->name, &sym->declared_at);
13187 if (sym->attr.pointer)
13189 "pointer-valued", sym->name, &sym->declared_at);
13191 if (sym->attr.pure)
13193 "pure", sym->name, &sym->declared_at);
13195 if (sym->attr.recursive)
13197 "recursive", sym->name, &sym->declared_at);
13206 if (!sym->attr.contained && !sym->ts.deferred
13207 && (sym->name[0] != '_' || sym->name[1] != '_'))
13210 sym->name, &sym->declared_at);
13214 if (sym->attr.elemental)
13216 if (sym->attr.proc_pointer)
13218 const char* name = (sym->attr.result ? sym->ns->proc_name->name
13219 : sym->name);
13221 name, &sym->declared_at);
13224 if (sym->attr.dummy)
13227 sym->name, &sym->declared_at);
13235 if (sym->result)
13236 allocatable_or_pointer = sym->result->ts.type == BT_CLASS
13237 && CLASS_DATA (sym->result) ?
13238 (CLASS_DATA (sym->result)->attr.allocatable
13239 || CLASS_DATA (sym->result)->attr.pointer) :
13240 (sym->result->attr.allocatable
13241 || sym->result->attr.pointer);
13243 if (sym->attr.elemental && sym->result
13248 "attribute", sym->result->name,
13249 &sym->result->declared_at, sym->name);
13253 if (sym->attr.is_bind_c && sym->attr.is_c_interop != 1)
13258 if (!verify_bind_c_sym (sym, &(sym->ts), sym->attr.in_common,
13259 sym->common_block))
13263 sym->attr.is_bind_c = 0;
13264 sym->attr.is_c_interop = 0;
13265 sym->ts.is_c_interop = 0;
13270 sym->attr.is_c_interop = 1;
13271 sym->ts.is_c_interop = 1;
13274 curr_arg = gfc_sym_get_dummy_args (sym);
13278 if (curr_arg->sym && curr_arg->sym->attr.implicit_type == 0)
13279 if (!gfc_verify_c_interop_param (curr_arg->sym))
13293 sym->attr.is_c_interop = 0;
13294 sym->ts.is_c_interop = 0;
13295 sym->attr.is_bind_c = 0;
13299 if (!sym->attr.proc_pointer)
13301 if (sym->attr.save == SAVE_EXPLICIT)
13304 "in %qs at %L", sym->name, &sym->declared_at);
13307 if (sym->attr.intent)
13310 "in %qs at %L", sym->name, &sym->declared_at);
13313 if (sym->attr.subroutine && sym->attr.result)
13316 "in %qs at %L", sym->ns->proc_name->name, &sym->declared_at);
13319 if (sym->attr.external && sym->attr.function && !sym->attr.module_procedure
13320 && ((sym->attr.if_source == IFSRC_DECL && !sym->attr.procedure)
13321 || sym->attr.contained))
13324 "in %qs at %L", sym->name, &sym->declared_at);
13327 if (strcmp ("ppr@", sym->name) == 0)
13331 sym->ns->proc_name->name, &sym->declared_at);
13338 if (sym->attr.if_source != IFSRC_DECL)
13339 sym->attr.array_outer_dependency = 1;
13345 if (sym->attr.module_procedure
13346 && sym->attr.if_source == IFSRC_DECL)
13352 strcpy (name, sym->ns->proc_name->name);
13356 iface = sym->tlink;
13357 sym->tlink = NULL;
13361 if (iface && sym->result
13364 sym->result->ts.u.cl = iface->ts.u.cl;
13370 if (sym->attr.elemental != iface->attr.elemental)
13374 &sym->declared_at, module_name);
13378 if (sym->attr.pure != iface->attr.pure)
13382 &sym->declared_at, module_name);
13386 if (sym->attr.recursive != iface->attr.recursive)
13390 &sym->declared_at, module_name);
13395 if (!gfc_check_result_characteristics (sym, iface, errmsg, 200))
13400 errmsg, module_name, &sym->declared_at,
13407 if (sym->formal && sym->formal_ns)
13409 for (arg = sym->formal; arg && arg->sym; arg = arg->next)
13412 gfc_traverse_ns (sym->formal_ns, compare_fsyms);
13419 if (sym->attr.is_bind_c && sym->attr.if_source == IFSRC_UNKNOWN)
13422 sym->name, &sym->declared_at);
13481 if (list->proc_tree->n.sym->formal->sym->as == NULL
13482 || list->proc_tree->n.sym->formal->sym->as->rank == 0)
13504 arg = dummy_args->sym;
13564 gfc_symbol* i_arg = dummy_args->sym;
13611 gfc_set_sym_referenced (c->initializer->symtree->n.sym);
13635 sym1 = t1->specific->u.specific->n.sym;
13636 sym2 = t2->specific->u.specific->n.sym;
13658 dummy_args = gfc_sym_get_dummy_args (t1->specific->u.specific->n.sym);
13660 pass1 = dummy_args->sym->name;
13670 dummy_args = gfc_sym_get_dummy_args (t2->specific->u.specific->n.sym);
13672 pass2 = dummy_args->sym->name;
13789 p->subroutine = first_target->n.sym->attr.subroutine;
13790 p->function = first_target->n.sym->attr.function;
13830 target_proc = target->specific->u.specific->n.sym;
13894 if (intr->sym == target_proc
13903 intr->sym = target_proc;
13923 static bool check_uop_procedure (gfc_symbol* sym, locus where);
14009 proc = stree->n.tb->u.specific->n.sym;
14080 if (!strcmp (i->sym->name, stree->n.tb->pass_arg))
14082 me_arg = i->sym;
14108 me_arg = dummy_args->sym;
14364 resolve_component (gfc_component *c, gfc_symbol *sym)
14375 if (sym->attr.vtype && sym->attr.use_assoc
14376 && sym->ns->proc_name == NULL)
14380 if ((!sym->attr.is_class || c != sym->components)
14434 if (sym->attr.is_bind_c && c->ts.type == BT_CHARACTER
14448 if (!sym->attr.vtype && !check_proc_interface (ifc, &c->loc))
14492 gfc_charlen *cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
14512 && !sym->attr.vtype)
14527 if (!strcmp (i->sym->name, c->tb->pass_arg))
14529 me_arg = i->sym;
14557 me_arg = c->ts.interface->formal->sym;
14563 || (me_arg->ts.type == BT_DERIVED && me_arg->ts.u.derived != sym)
14565 && CLASS_DATA (me_arg)->ts.u.derived != sym))
14569 me_arg->name, &c->loc, sym->name);
14602 if (gfc_type_is_extensible (sym) && me_arg->ts.type != BT_CLASS)
14612 if (((sym->attr.is_class
14613 && (!sym->components->ts.u.derived->attr.extension
14614 || c != sym->components->ts.u.derived->components))
14615 || (!sym->attr.is_class
14616 && (!sym->attr.extension || c != sym->components)))
14617 && !sym->attr.vtype
14621 super_type = gfc_get_derived_super_type (sym);
14626 && ((sym->attr.is_class
14627 && c == sym->components->ts.u.derived->components)
14628 || (!sym->attr.is_class && c == sym->components))
14634 if (super_type && !sym->attr.is_class
14639 c->name, sym->name, &c->loc);
14676 c->name, sym->name, &c->loc);
14684 && !sym->attr.is_class)
14689 strlen = gfc_find_component (sym, name, true, true, NULL);
14692 if (!gfc_add_component (sym, name, &strlen))
14702 && sym->component_access != ACCESS_PRIVATE
14703 && gfc_check_symbol_access (sym)
14704 && !is_sym_host_assoc (c->ts.u.derived, sym->ns)
14710 sym->name, &sym->declared_at))
14713 if ((sym->attr.sequence || sym->attr.is_bind_c) && c->ts.type == BT_CLASS)
14716 "type %s", c->name, &c->loc, sym->name);
14720 if (sym->attr.sequence)
14726 c->ts.u.derived->name, &sym->declared_at);
14742 && c->ts.u.derived == sym && c->attr.allocatable == 1)
14752 && sym != c->ts.u.derived)
14760 if (c->initializer && !sym->attr.vtype
14762 && !gfc_check_assign_symbol (sym, c, c->initializer))
14793 resolve_fl_struct (gfc_symbol *sym)
14800 if (sym->attr.flavor == FL_UNION)
14802 for (c = sym->components; c; c = c->next)
14817 for (c = sym->components; c; c = c->next)
14818 if (!resolve_component (c, sym))
14824 if (sym->components)
14825 add_dt_to_dt_list (sym);
14836 resolve_fl_derived0 (gfc_symbol *sym)
14843 if (sym->attr.unlimited_polymorphic)
14846 super_type = gfc_get_derived_super_type (sym);
14849 if (super_type && sym->attr.coarray_comp && !super_type->attr.coarray_comp)
14852 "parent type %qs shall also have one", sym->name,
14853 &sym->declared_at, super_type->name);
14862 if (sym->attr.abstract && !gfc_type_is_extensible (sym))
14865 sym->name, &sym->declared_at);
14869 c = (sym->attr.is_class) ? sym->components->ts.u.derived->components
14870 : sym->components;
14874 if (!resolve_component (c, sym))
14882 && !sym->attr.is_class && !sym->attr.vtype)
14884 for (c = sym->components; c; c = c->next)
14891 token = gfc_find_component (sym, name, true, true, NULL);
14894 if (!gfc_add_component (sym, name, &token))
14905 check_defined_assignments (sym);
14907 if (!sym->attr.defined_assign_comp && super_type)
14908 sym->attr.defined_assign_comp
14913 if (super_type && super_type->attr.abstract && !sym->attr.abstract
14914 && !sym->attr.is_class
14915 && !ensure_not_abstract (sym, super_type))
14919 if (sym->attr.pdt_template)
14921 for (f = sym->formal; f; f = f->next)
14923 if (!f->sym)
14925 c = gfc_find_component (sym, f->sym->name, true, true, NULL);
14929 "corresponding to parameter %qs at %L", sym->name,
14930 f->sym->name, &sym->declared_at);
14937 add_dt_to_dt_list (sym);
14949 resolve_fl_derived (gfc_symbol *sym)
14953 if (sym->attr.unlimited_polymorphic)
14956 if (!sym->attr.is_class)
14957 gfc_find_symbol (sym->name, sym->ns, 0, &gen_dt);
14959 && (!gen_dt->generic->sym->attr.use_assoc
14960 || gen_dt->generic->sym->module != gen_dt->generic->next->sym->module)
14963 "type at %L", sym->name,
14964 gen_dt->generic->sym == sym
14965 ? gen_dt->generic->next->sym->name
14966 : gen_dt->generic->sym->name,
14967 gen_dt->generic->sym == sym
14968 ? &gen_dt->generic->next->sym->declared_at
14969 : &gen_dt->generic->sym->declared_at,
14970 &sym->declared_at))
14973 if (sym->components == NULL && !sym->attr.zero_comp && !sym->attr.use_assoc)
14976 sym->name, &sym->declared_at);
14981 if (!gfc_resolve_finalizers (sym, NULL))
14984 if (sym->attr.is_class && sym->ts.u.derived == NULL)
14987 gfc_component *data = gfc_find_component (sym, "_data", true, true, NULL);
14988 gfc_component *vptr = gfc_find_component (sym, "_vptr", true, true, NULL);
15003 if (!resolve_fl_derived0 (sym))
15007 if (!resolve_typebound_procedures (sym))
15015 && sym->ns->proc_name
15016 && sym->ns->proc_name->attr.flavor == FL_MODULE
15017 && sym->attr.access != ACCESS_PRIVATE
15018 && !(sym->attr.use_assoc || sym->attr.vtype || sym->attr.pdt_template))
15020 gfc_symbol *vtab = gfc_find_derived_vtab (sym);
15029 resolve_fl_namelist (gfc_symbol *sym)
15034 for (nl = sym->namelist; nl; nl = nl->next)
15038 if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SIZE)
15041 "allowed", nl->sym->name, sym->name, &sym->declared_at);
15045 if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE
15048 nl->sym->name, sym->name, &sym->declared_at))
15051 if (is_non_constant_shape_array (nl->sym)
15054 nl->sym->name, sym->name, &sym->declared_at))
15057 if (nl->sym->ts.type == BT_CHARACTER
15058 && (nl->sym->ts.u.cl->length == NULL
15059 || !gfc_is_constant_expr (nl->sym->ts.u.cl->length))
15062 "namelist %qs at %L", nl->sym->name,
15063 sym->name, &sym->declared_at))
15069 if (gfc_check_symbol_access (sym))
15071 for (nl = sym->namelist; nl; nl = nl->next)
15073 if (!nl->sym->attr.use_assoc
15074 && !is_sym_host_assoc (nl->sym, sym->ns)
15075 && !gfc_check_symbol_access (nl->sym))
15079 nl->sym->name, sym->name, &sym->declared_at);
15083 if (nl->sym->ts.type == BT_DERIVED
15084 && (nl->sym->ts.u.derived->attr.alloc_comp
15085 || nl->sym->ts.u.derived->attr.pointer_comp))
15089 "or POINTER components", nl->sym->name,
15090 sym->name, &sym->declared_at))
15096 if (nl->sym->ts.type == BT_DERIVED
15097 && derived_inaccessible (nl->sym->ts.u.derived))
15101 nl->sym->name, sym->name, &sym->declared_at);
15106 if (nl->sym->ts.type == BT_DERIVED
15107 && !is_sym_host_assoc (nl->sym->ts.u.derived, sym->ns)
15108 && nl->sym->ts.u.derived->attr.private_comp)
15112 nl->sym->name, sym->name, &sym->declared_at);
15121 for (nl = sym->namelist; nl; nl = nl->next)
15123 if (nl->sym->ts.kind != 0 && nl->sym->attr.flavor == FL_VARIABLE)
15126 if (nl->sym->attr.function && nl->sym == nl->sym->result)
15127 if ((nl->sym == sym->ns->proc_name)
15129 (sym->ns->parent && nl->sym == sym->ns->parent->proc_name))
15133 if (nl->sym->name)
15134 gfc_find_symbol (nl->sym->name, sym->ns, 1, &nlsym);
15139 &sym->declared_at);
15149 resolve_fl_parameter (gfc_symbol *sym)
15152 if (sym->as != NULL
15153 && (sym->as->type == AS_DEFERRED
15154 || is_non_constant_shape_array (sym)))
15157 "or of deferred shape", sym->name, &sym->declared_at);
15162 if (!deferred_requirements (sym))
15168 if (sym->attr.implicit_type
15169 && !gfc_compare_types (&sym->ts, gfc_get_default_type (sym->name,
15170 sym->ns)))
15173 "later IMPLICIT type", sym->name, &sym->declared_at);
15180 if (sym->ts.type == BT_DERIVED
15181 && !gfc_compare_types (&sym->ts, &sym->value->ts))
15184 &sym->value->where);
15189 if (sym->ts.type == BT_CLASS)
15192 sym->name, &sym->declared_at);
15203 resolve_pdt (gfc_symbol* sym)
15212 if (sym->ts.type == BT_DERIVED)
15214 derived = sym->ts.u.derived;
15215 attr = &(sym->attr);
15217 else if (sym->ts.type == BT_CLASS)
15219 derived = CLASS_DATA (sym)->ts.u.derived;
15220 attr = &(CLASS_DATA (sym)->attr);
15227 for (param = sym->param_list; param; param = param->next)
15244 "nor a pointer", sym->name, &sym->declared_at,
15250 && (sym->ns->proc_name->attr.is_main_program
15251 || sym->ns->proc_name->attr.flavor == FL_MODULE
15252 || sym->attr.save != SAVE_NONE))
15256 sym->name, &sym->declared_at);
15258 if (assumed_len_exprs && !(sym->attr.dummy
15259 || sym->attr.select_type_temporary || sym->attr.associate_var))
15262 sym->name, &sym->declared_at);
15271 resolve_symbol (gfc_symbol *sym)
15282 if (sym->resolve_symbol_called >= 1)
15284 sym->resolve_symbol_called = 1;
15289 gcc_assert (sym->ts.type != BT_UNION);
15293 if (flag_coarray == GFC_FCOARRAY_LIB && sym->ts.type == BT_CLASS
15294 && sym->ts.u.derived && CLASS_DATA (sym)
15295 && CLASS_DATA (sym)->attr.codimension
15296 && CLASS_DATA (sym)->ts.u.derived
15297 && (CLASS_DATA (sym)->ts.u.derived->attr.alloc_comp
15298 || CLASS_DATA (sym)->ts.u.derived->attr.pointer_comp))
15301 "type coarrays at %L are unsupported", &sym->declared_at);
15305 if (sym->attr.artificial)
15308 if (sym->attr.unlimited_polymorphic)
15311 if (sym->attr.flavor == FL_UNKNOWN
15312 || (sym->attr.flavor == FL_PROCEDURE && !sym->attr.intrinsic
15313 && !sym->attr.generic && !sym->attr.external
15314 && sym->attr.if_source == IFSRC_UNKNOWN
15315 && sym->ts.type == BT_UNKNOWN))
15323 symtree = gfc_find_symtree (ns->sym_root, sym->name);
15324 if (symtree && (symtree->n.sym->generic ||
15325 (symtree->n.sym->attr.flavor == FL_PROCEDURE
15326 && sym->ns->construct_entities)))
15329 sym->name);
15330 if (this_symtree->n.sym == sym)
15332 symtree->n.sym->refs++;
15333 gfc_release_symbol (sym);
15334 this_symtree->n.sym = symtree->n.sym;
15342 if (sym->attr.flavor == FL_UNKNOWN && sym->attr.external == 0
15343 && sym->attr.intrinsic == 0)
15344 sym->attr.flavor = FL_VARIABLE;
15345 else if (sym->attr.flavor == FL_UNKNOWN)
15347 sym->attr.flavor = FL_PROCEDURE;
15348 if (sym->attr.dimension)
15349 sym->attr.function = 1;
15353 if (sym->attr.external && sym->ts.type != BT_UNKNOWN && !sym->attr.function)
15354 gfc_add_function (&sym->attr, sym->name, &sym->declared_at);
15356 if (sym->attr.procedure && sym->attr.if_source != IFSRC_DECL
15357 && !resolve_procedure_interface (sym))
15360 if (sym->attr.is_protected && !sym->attr.proc_pointer
15361 && (sym->attr.procedure || sym->attr.external))
15363 if (sym->attr.external)
15365 "at %L", &sym->declared_at);
15368 "at %L", &sym->declared_at);
15373 if (sym->attr.flavor == FL_DERIVED && !resolve_fl_derived (sym))
15376 else if ((sym->attr.flavor == FL_STRUCT || sym->attr.flavor == FL_UNION)
15377 && !resolve_fl_struct (sym))
15385 mp_flag = (sym->result != NULL && sym->result != sym);
15390 if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic
15391 && !gfc_resolve_intrinsic (sym, &sym->declared_at))
15395 if (sym->assoc)
15396 resolve_assoc_var (sym, true);
15399 if (sym->ts.type == BT_UNKNOWN)
15401 if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER)
15403 gfc_set_default_type (sym, 1, NULL);
15406 if (sym->attr.flavor == FL_PROCEDURE && sym->attr.external
15407 && !sym->attr.function && !sym->attr.subroutine
15408 && gfc_get_default_type (sym->name, sym->ns)->type == BT_UNKNOWN)
15409 gfc_add_subroutine (&sym->attr, sym->name, &sym->declared_at);
15411 if (sym->attr.flavor == FL_PROCEDURE && sym->attr.function)
15417 if (!sym->attr.mixed_entry_master)
15418 gfc_set_default_type (sym, sym->attr.external, NULL);
15423 resolve_symbol (sym->result);
15425 if (!sym->result->attr.proc_pointer)
15427 sym->ts = sym->result->ts;
15428 sym->as = gfc_copy_array_spec (sym->result->as);
15429 sym->attr.dimension = sym->result->attr.dimension;
15430 sym->attr.pointer = sym->result->attr.pointer;
15431 sym->attr.allocatable = sym->result->attr.allocatable;
15432 sym->attr.contiguous = sym->result->attr.contiguous;
15437 else if (mp_flag && sym->attr.flavor == FL_PROCEDURE && sym->attr.function)
15441 gfc_resolve_array_spec (sym->result->as, false);
15445 if (sym->ts.type == BT_CLASS && sym->attr.class_ok && sym->ts.u.derived)
15447 as = CLASS_DATA (sym)->as;
15448 class_attr = CLASS_DATA (sym)->attr;
15453 class_attr = sym->attr;
15454 as = sym->as;
15458 if (sym->attr.contiguous
15465 sym->name, &sym->declared_at);
15494 && !sym->attr.dummy && !sym->attr.select_type_temporary)
15498 &sym->declared_at);
15501 &sym->declared_at);
15505 if (as->type == AS_ASSUMED_RANK && !sym->attr.dummy
15506 && !sym->attr.select_type_temporary
15511 &sym->declared_at);
15515 && (sym->attr.codimension || sym->attr.value))
15518 "CODIMENSION attribute", &sym->declared_at);
15527 if (!sym->attr.dummy
15528 && (sym->attr.optional || sym->attr.intent != INTENT_UNKNOWN))
15530 gfc_error ("Symbol at %L is not a DUMMY variable", &sym->declared_at);
15534 if (sym->attr.value && !sym->attr.dummy)
15537 "it is not a dummy argument", sym->name, &sym->declared_at);
15541 if (sym->attr.value && sym->ts.type == BT_CHARACTER)
15543 gfc_charlen *cl = sym->ts.u.cl;
15548 sym->name, &sym->declared_at);
15552 if (sym->ts.is_c_interop
15557 sym->name, &sym->declared_at);
15562 if (sym->ts.type == BT_DERIVED && !sym->attr.is_iso_c
15563 && sym->ts.u.derived->attr.generic)
15565 sym->ts.u.derived = gfc_find_dt_in_generic (sym->ts.u.derived);
15566 if (!sym->ts.u.derived)
15569 "which has not been defined", sym->name,
15570 &sym->declared_at, sym->ts.u.derived->name);
15571 sym->ts.type = BT_UNKNOWN;
15578 if (sym->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK))
15580 if (!sym->attr.dummy)
15583 "a dummy argument", sym->name, &sym->declared_at);
15587 if (sym->ts.type != BT_ASSUMED && sym->ts.type != BT_INTEGER
15588 && sym->ts.type != BT_REAL && sym->ts.type != BT_LOGICAL
15589 && sym->ts.type != BT_COMPLEX)
15593 sym->name, &sym->declared_at);
15597 if (sym->attr.allocatable || sym->attr.codimension
15598 || sym->attr.pointer || sym->attr.value)
15602 "attribute", sym->name, &sym->declared_at);
15606 if (sym->attr.intent == INTENT_OUT)
15610 sym->name, &sym->declared_at);
15613 if (sym->attr.dimension && sym->as->type != AS_ASSUMED_SIZE)
15617 sym->name, &sym->declared_at);
15624 sym->ts.type = BT_ASSUMED;
15625 sym->as = gfc_get_array_spec ();
15626 sym->as->type = AS_ASSUMED_SIZE;
15627 sym->as->rank = 1;
15628 sym->as->lower[0] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
15630 else if (sym->ts.type == BT_ASSUMED)
15633 if (!sym->attr.dummy)
15636 "for dummy variables", sym->name, &sym->declared_at);
15639 if (sym->attr.allocatable || sym->attr.codimension
15640 || sym->attr.pointer || sym->attr.value)
15644 sym->name, &sym->declared_at);
15647 if (sym->attr.intent == INTENT_OUT)
15651 sym->name, &sym->declared_at);
15654 if (sym->attr.dimension && sym->as->type == AS_EXPLICIT)
15657 "explicit-shape array", sym->name, &sym->declared_at);
15671 if (sym->attr.is_bind_c && sym->attr.use_assoc == 0
15672 && sym->attr.dummy == 0 && sym->attr.flavor != FL_PROCEDURE
15673 && sym->attr.flavor != FL_DERIVED)
15679 if (!(sym->ns->proc_name && sym->ns->proc_name->attr.flavor == FL_MODULE)
15680 && !sym->attr.in_common)
15684 "module level scope", sym->name, &(sym->declared_at));
15687 else if (sym->ts.type == BT_CHARACTER
15688 && (sym->ts.u.cl == NULL || sym->ts.u.cl->length == NULL
15689 || !gfc_is_constant_expr (sym->ts.u.cl->length)
15690 || mpz_cmp_si (sym->ts.u.cl->length->value.integer, 1) != 0))
15693 sym->name, &sym->declared_at);
15696 else if (sym->common_head != NULL && sym->attr.implicit_type == 0)
15698 t = verify_com_block_vars_c_interop (sym->common_head);
15700 else if (sym->attr.implicit_type == 0)
15704 if (sym->ts.type == BT_DERIVED &&
15705 sym->ts.u.derived->attr.is_c_interop != 1)
15711 if (sym->ts.u.derived->attr.is_bind_c != 1)
15712 verify_bind_c_derived_type (sym->ts.u.derived);
15720 t = verify_bind_c_sym (sym, &(sym->ts), sym->attr.in_common,
15721 sym->common_block);
15728 sym->attr.is_bind_c = 0;
15741 if (sym->ts.type == BT_DERIVED && !sym->attr.is_iso_c
15742 && sym->ts.u.derived->components == NULL
15743 && !sym->ts.u.derived->attr.zero_comp)
15746 "which has not been defined", sym->name,
15747 &sym->declared_at, sym->ts.u.derived->name);
15748 sym->ts.type = BT_UNKNOWN;
15755 if (sym->ts.type == BT_DERIVED
15756 && sym->ts.u.derived->attr.use_assoc
15757 && sym->ns->proc_name
15758 && sym->ns->proc_name->attr.flavor == FL_MODULE
15759 && !resolve_fl_derived (sym->ts.u.derived))
15766 if (sym->ts.type == BT_DERIVED
15767 && sym->ns->proc_name && sym->ns->proc_name->attr.flavor == FL_MODULE
15768 && !sym->ts.u.derived->attr.use_assoc
15769 && gfc_check_symbol_access (sym)
15770 && !gfc_check_symbol_access (sym->ts.u.derived)
15773 (sym->attr.flavor == FL_PARAMETER)
15775 sym->name, &sym->declared_at,
15776 sym->ts.u.derived->name))
15780 if (sym->ts.type == BT_DERIVED
15781 && ((sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
15782 && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
15783 || sym->ts.u.derived->attr.lock_comp)
15784 && !sym->attr.codimension && !sym->ts.u.derived->attr.coarray_comp)
15787 "type LOCK_TYPE must be a coarray", sym->name,
15788 &sym->declared_at);
15793 if (sym->ts.type == BT_DERIVED
15794 && ((sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
15795 && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)
15796 || sym->ts.u.derived->attr.event_comp)
15797 && !sym->attr.codimension && !sym->ts.u.derived->attr.coarray_comp)
15800 "type EVENT_TYPE must be a coarray", sym->name,
15801 &sym->declared_at);
15807 if (sym->ts.type == BT_DERIVED
15808 && sym->attr.dummy
15809 && sym->attr.intent == INTENT_OUT
15810 && sym->as
15811 && sym->as->type == AS_ASSUMED_SIZE)
15813 for (c = sym->ts.u.derived->components; c; c = c->next)
15819 sym->name, &sym->declared_at);
15826 if (sym->ts.type == BT_DERIVED && sym->attr.dummy
15827 && sym->attr.intent == INTENT_OUT && sym->attr.lock_comp)
15830 "INTENT(OUT)", sym->name, &sym->declared_at);
15835 if (sym->ts.type == BT_DERIVED && sym->attr.dummy
15836 && sym->attr.intent == INTENT_OUT && sym->attr.event_comp)
15839 "INTENT(OUT)", sym->name, &sym->declared_at);
15844 if ((((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
15845 || (sym->ts.type == BT_CLASS && sym->attr.class_ok
15846 && sym->ts.u.derived && CLASS_DATA (sym)
15847 && CLASS_DATA (sym)->attr.coarray_comp))
15849 && (sym->attr.result || sym->result == sym))
15852 "a coarray component", sym->name, &sym->declared_at);
15857 if (sym->attr.codimension && sym->ts.type == BT_DERIVED
15858 && sym->ts.u.derived->ts.is_iso_c)
15861 "shall not be a coarray", sym->name, &sym->declared_at);
15866 if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
15867 || (sym->ts.type == BT_CLASS && sym->attr.class_ok
15868 && sym->ts.u.derived && CLASS_DATA (sym)
15869 && CLASS_DATA (sym)->attr.coarray_comp))
15875 sym->name, &sym->declared_at);
15881 && !(class_attr.allocatable || sym->attr.dummy || sym->attr.save
15882 || sym->attr.select_type_temporary
15883 || sym->attr.associate_var
15884 || (sym->ns->save_all && !sym->attr.automatic)
15885 || sym->ns->proc_name->attr.flavor == FL_MODULE
15886 || sym->ns->proc_name->attr.is_main_program
15887 || sym->attr.function || sym->attr.result || sym->attr.use_assoc))
15890 "nor a dummy argument", sym->name, &sym->declared_at);
15894 else if (class_attr.codimension && !sym->attr.select_type_temporary
15898 "deferred shape", sym->name, &sym->declared_at);
15905 "deferred shape", sym->name, &sym->declared_at);
15910 if ((((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
15911 || (sym->ts.type == BT_CLASS && sym->attr.class_ok
15912 && sym->ts.u.derived && CLASS_DATA (sym)
15913 && CLASS_DATA (sym)->attr.coarray_comp))
15915 && sym->attr.dummy && sym->attr.intent == INTENT_OUT)
15919 sym->name, &sym->declared_at);
15923 if (class_attr.codimension && sym->attr.dummy
15924 && sym->ns->proc_name && sym->ns->proc_name->attr.is_bind_c)
15927 "procedure %qs", sym->name, &sym->declared_at,
15928 sym->ns->proc_name->name);
15932 if (sym->ts.type == BT_LOGICAL
15933 && ((sym->attr.function && sym->attr.is_bind_c && sym->result == sym)
15934 || ((sym->attr.dummy || sym->attr.result) && sym->ns->proc_name
15935 && sym->ns->proc_name->attr.is_bind_c)))
15939 if (gfc_logical_kinds[i].kind == sym->ts.kind)
15941 if (!gfc_logical_kinds[i].c_bool && sym->attr.dummy
15944 "%qs", sym->name, &sym->declared_at,
15945 sym->ns->proc_name->name))
15950 "BIND(C) procedure %qs", sym->name,
15951 &sym->declared_at,
15952 sym->attr.function ? sym->name
15953 : sym->ns->proc_name->name))
15957 switch (sym->attr.flavor)
15960 if (!resolve_fl_variable (sym, mp_flag))
15965 if (sym->formal && !sym->formal_ns)
15968 gfc_formal_arglist *formal = sym->formal;
15971 if (formal->sym && formal->sym->attr.flavor == FL_NAMELIST)
15975 formal->sym->name, &sym->declared_at);
15980 if (!resolve_fl_procedure (sym, mp_flag))
15985 if (!resolve_fl_namelist (sym))
15990 if (!resolve_fl_parameter (sym))
16001 check_constant = sym->attr.in_common && !sym->attr.pointer;
16006 if ((sym->attr.function || sym->attr.result) && sym->as)
16011 gfc_resolve_array_spec (sym->as, check_constant);
16017 if (sym->formal_ns && sym->formal_ns != gfc_current_ns
16018 && !sym->attr.contained && !sym->attr.intrinsic)
16019 gfc_resolve (sym->formal_ns);
16022 if (sym->formal && !sym->formal_ns)
16024 gfc_formal_arglist *formal = sym->formal;
16025 while (formal && !formal->sym)
16030 sym->formal_ns = formal->sym->ns;
16031 if (sym->formal_ns && sym->ns != formal->sym->ns)
16032 sym->formal_ns->refs++;
16037 if (sym->attr.threadprivate && !sym->attr.save
16038 && !(sym->ns->save_all && !sym->attr.automatic)
16039 && (!sym->attr.in_common
16040 && sym->module == NULL
16041 && (sym->ns->proc_name == NULL
16042 || sym->ns->proc_name->attr.flavor != FL_MODULE)))
16043 gfc_error ("Threadprivate at %L isn't SAVEd", &sym->declared_at);
16046 if (sym->attr.omp_declare_target
16047 && sym->attr.flavor == FL_VARIABLE
16048 && !sym->attr.save
16049 && !(sym->ns->save_all && !sym->attr.automatic)
16050 && (!sym->attr.in_common
16051 && sym->module == NULL
16052 && (sym->ns->proc_name == NULL
16053 || sym->ns->proc_name->attr.flavor != FL_MODULE)))
16055 sym->name, &sym->declared_at);
16060 if (sym->ts.type == BT_DERIVED
16061 && !sym->value
16062 && !sym->attr.allocatable
16063 && !sym->attr.alloc_comp)
16065 symbol_attribute *a = &sym->attr;
16072 || sym->ts.u.derived->attr.alloc_comp
16073 || sym->ts.u.derived->attr.pointer_comp))
16074 && !(a->function && sym != sym->result))
16076 apply_default_init (sym);
16077 else if (a->function && sym->result && a->access != ACCESS_PRIVATE
16078 && (sym->ts.u.derived->attr.alloc_comp
16079 || sym->ts.u.derived->attr.pointer_comp))
16082 sym->result->attr.referenced = 1;
16085 if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns
16086 && sym->attr.dummy && sym->attr.intent == INTENT_OUT
16087 && !CLASS_DATA (sym)->attr.class_pointer
16088 && !CLASS_DATA (sym)->attr.allocatable)
16089 apply_default_init (sym);
16092 if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER
16093 || (sym->attr.flavor == FL_PROCEDURE && sym->attr.function))
16094 if (!resolve_typespec_used (&sym->ts, &sym->declared_at, sym->name))
16097 if (sym->param_list)
16098 resolve_pdt (sym);
16143 gfc_symbol *sym;
16163 sym = e->symtree->n.sym;
16165 if (sym->ns->is_block_data && !sym->attr.in_common)
16168 sym->name, &sym->declared_at);
16172 if (e->ref == NULL && sym->as)
16175 " declaration", sym->name, where);
16181 gfc_error ("DATA element %qs at %L cannot have a coindex", sym->name,
16186 has_pointer = sym->attr.pointer;
16198 "be a full array", sym->name, where);
16527 gfc_impure_variable (gfc_symbol *sym)
16532 if (sym->attr.use_assoc || sym->attr.in_common)
16538 if (ns == sym->ns)
16540 if (ns->proc_name->attr.flavor == FL_PROCEDURE && !sym->attr.function)
16544 proc = sym->ns->proc_name;
16545 if (sym->attr.dummy
16546 && !sym->attr.value
16547 && ((proc->attr.subroutine && sym->attr.intent == INTENT_IN)
16562 gfc_pure (gfc_symbol *sym)
16567 if (sym == NULL)
16573 sym = ns->proc_name;
16574 if (sym == NULL)
16576 attr = sym->attr;
16583 attr = sym->attr;
16594 gfc_implicit_pure (gfc_symbol *sym)
16598 if (sym == NULL)
16604 sym = ns->proc_name;
16605 if (sym == NULL)
16608 if (sym->attr.flavor == FL_PROCEDURE)
16613 return sym->attr.flavor == FL_PROCEDURE && sym->attr.implicit_pure
16614 && !sym->attr.pure;
16619 gfc_unset_implicit_pure (gfc_symbol *sym)
16623 if (sym == NULL)
16629 sym = ns->proc_name;
16630 if (sym == NULL)
16633 if (sym->attr.flavor == FL_PROCEDURE)
16638 if (sym->attr.flavor == FL_PROCEDURE)
16639 sym->attr.implicit_pure = 0;
16641 sym->attr.pure = 0;
16648 gfc_elemental (gfc_symbol *sym)
16652 if (sym == NULL)
16653 sym = gfc_current_ns->proc_name;
16654 if (sym == NULL)
16656 attr = sym->attr;
16758 resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
16769 "attribute to be an EQUIVALENCE object", sym->name,
16778 "components to be an EQUIVALENCE object",sym->name,
16783 if (sym->attr.in_common && gfc_has_default_initializer (sym->ts.u.derived))
16787 "in COMMON", sym->name, &e->where);
16794 && (!resolve_equivalence_derived(c->ts.u.derived, sym, e)))
16803 sym->name, &e->where);
16827 gfc_symbol *sym;
16837 last_ts = &eq->expr->symtree->n.sym->ts;
16839 first_sym = eq->expr->symtree->n.sym;
16847 e->ts = e->symtree->n.sym->ts;
16854 sym = e->symtree->n.sym;
16856 if (sym->attr.dimension)
16858 ref->u.ar.as = sym->as;
16913 sym = e->symtree->n.sym;
16915 if (sym->attr.is_protected)
16927 if (sym->ns->proc_name
16928 && sym->ns->proc_name->attr.pure
16929 && sym->attr.in_common)
16934 if (sym->ns->use_stmts)
16937 for (r = sym->ns->use_stmts->rename; r; r = r->next)
16938 if (strcmp(r->use_name, sym->name) == 0) saw_sym = true;
16946 sym->name, &e->where, sym->ns->proc_name->name);
16954 "object", sym->name, &e->where);
16959 && !resolve_equivalence_derived (e->ts.u.derived, sym, e))
16974 if (object == 1 || gfc_compare_types (last_ts, &sym->ts))
16978 eq_type = sequence_type (sym->ts);
16989 && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where)))
16998 && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where)))
17005 && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where))
17012 && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where))
17017 last_ts =&sym->ts;
17024 if (e->ref->type == REF_ARRAY && is_non_constant_shape_array (sym))
17027 "an EQUIVALENCE object", sym->name, &e->where);
17064 gfc_symbol *sym,
17072 s = expr->symtree->n.sym;
17077 if (sym == s)
17080 "for %qs at %L", sym->name, &expr->where);
17095 st->n.sym = s;
17120 gfc_symbol *sym;
17126 synthetic symbol and ns->entries->sym actual FUNCTION symbol. */
17128 sym = ns->entries->sym;
17130 sym = ns->proc_name;
17131 if (sym->result == sym
17132 && sym->ts.type == BT_UNKNOWN
17133 && !gfc_set_default_type (sym, 0, NULL)
17134 && !sym->attr.untyped)
17137 sym->name, &sym->declared_at);
17138 sym->attr.untyped = 1;
17141 if (sym->ts.type == BT_DERIVED && !sym->ts.u.derived->attr.use_assoc
17142 && !sym->attr.contained
17143 && !gfc_check_symbol_access (sym->ts.u.derived)
17144 && gfc_check_symbol_access (sym))
17147 "%L of PRIVATE type %qs", sym->name,
17148 &sym->declared_at, sym->ts.u.derived->name);
17154 if (el->sym->result == el->sym
17155 && el->sym->ts.type == BT_UNKNOWN
17156 && !gfc_set_default_type (el->sym, 0, NULL)
17157 && !el->sym->attr.untyped)
17160 el->sym->name, &el->sym->declared_at);
17161 el->sym->attr.untyped = 1;
17165 if (sym->ts.type == BT_CHARACTER
17166 && sym->ts.u.cl->length
17167 && sym->ts.u.cl->length->ts.type == BT_INTEGER)
17168 gfc_traverse_expr (sym->ts.u.cl->length, sym, flag_fn_result_spec, 0);
17175 check_uop_procedure (gfc_symbol *sym, locus where)
17179 if (!sym->attr.function)
17182 sym->name, &where);
17186 if (sym->ts.type == BT_CHARACTER
17187 && !((sym->ts.u.cl && sym->ts.u.cl->length) || sym->ts.deferred)
17188 && !(sym->result && ((sym->result->ts.u.cl
17189 && sym->result->ts.u.cl->length) || sym->result->ts.deferred)))
17192 "character length", sym->name, &where);
17196 formal = gfc_sym_get_dummy_args (sym);
17197 if (!formal || !formal->sym)
17200 "one argument", sym->name, &where);
17204 if (formal->sym->attr.intent != INTENT_IN)
17211 if (formal->sym->attr.optional)
17219 if (!formal || !formal->sym)
17222 if (formal->sym->attr.intent != INTENT_IN)
17229 if (formal->sym->attr.optional)
17258 check_uop_procedure (itr->sym, itr->sym->declared_at);