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 (symsym->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);
808 && (el->sym->result->attr.allocatable
809 != ns->entries->sym->result->attr.allocatable))
812 "characteristics", ns->entries->sym->name,
813 &ns->entries->sym->declared_at, el->sym->name);
828 "string lengths", ns->entries->sym->name,
829 &ns->entries->sym->declared_at);
834 sym = ns->entries->sym->result;
837 if (sym->attr.dimension)
838 gfc_set_array_spec (proc, gfc_copy_array_spec (sym->as), NULL);
839 if (sym->attr.pointer)
849 sym = el->sym->result;
850 if (sym->attr.dimension)
854 "FUNCTION %s at %L", sym->name,
855 ns->entries->sym->name, &sym->declared_at);
858 "FUNCTION %s at %L", sym->name,
859 ns->entries->sym->name, &sym->declared_at);
861 else if (sym->attr.pointer)
865 "FUNCTION %s at %L", sym->name,
866 ns->entries->sym->name, &sym->declared_at);
869 "FUNCTION %s at %L", sym->name,
870 ns->entries->sym->name, &sym->declared_at);
874 ts = &sym->ts;
876 ts = gfc_get_default_type (sym->name, NULL);
881 sym = NULL;
886 sym = NULL;
890 sym = NULL;
894 sym = NULL;
898 sym = NULL;
903 if (sym)
907 "in FUNCTION %s at %L", sym->name,
908 gfc_typename (ts), ns->entries->sym->name,
909 &sym->declared_at);
912 "in FUNCTION %s at %L", sym->name,
913 gfc_typename (ts), ns->entries->sym->name,
914 &sym->declared_at);
927 merge_argument_lists (proc, el->sym->formal);
932 check_argument_lists (proc, el->sym->formal);
1019 gfc_symbol *sym;
1110 gfc_find_symbol (common_root->name, gfc_current_ns, 0, &sym);
1111 if (sym == NULL)
1114 if (sym->attr.flavor == FL_PARAMETER)
1116 sym->name, &common_root->n.common->where, &sym->declared_at);
1118 if (sym->attr.external)
1120 sym->name, &common_root->n.common->where);
1122 if (sym->attr.intrinsic)
1124 sym->name, &common_root->n.common->where);
1125 else if (sym->attr.result
1126 || gfc_is_function_return_value (sym, gfc_current_ns))
1128 "that is also a function result", sym->name,
1130 else if (sym->attr.flavor == FL_PROCEDURE && sym->attr.proc != PROC_INTERNAL
1131 && sym->attr.proc != PROC_ST_FUNCTION)
1133 "that is also a global procedure", sym->name,
1163 resolve_contained_fntype (el->sym, child);
1252 static bool resolve_fl_derived0 (gfc_symbol *sym);
1253 static bool resolve_fl_struct (gfc_symbol *sym);
1301 comp = expr->ref->u.c.sym->components;
1400 && cons->expr->symtree->n.sym->attr.flavor == FL_PARAMETER)
1459 s2 = cons->expr->symtree->n.sym->result;
1460 name = cons->expr->symtree->n.sym->result->name;
1464 s2 = cons->expr->symtree->n.sym;
1465 name = cons->expr->symtree->n.sym->name;
1548 && (gfc_impure_variable (cons->expr->symtree->n.sym)
1572 was_declared (gfc_symbol *sym)
1576 a = sym->attr;
1578 if (!a.implicit_type && sym->ts.type != BT_UNKNOWN)
1594 generic_sym (gfc_symbol *sym)
1598 if (sym->attr.generic ||
1599 (sym->attr.intrinsic && gfc_generic_intrinsic (sym->name)))
1602 if (was_declared (sym) || sym->ns->parent == NULL)
1605 gfc_find_symbol (sym->name, sym->ns->parent, 1, &s);
1609 if (s == sym)
1622 specific_sym (gfc_symbol *sym)
1626 if (sym->attr.if_source == IFSRC_IFBODY
1627 || sym->attr.proc == PROC_MODULE
1628 || sym->attr.proc == PROC_INTERNAL
1629 || sym->attr.proc == PROC_ST_FUNCTION
1630 || (sym->attr.intrinsic && gfc_specific_intrinsic (sym->name))
1631 || sym->attr.external)
1634 if (was_declared (sym) || sym->ns->parent == NULL)
1637 gfc_find_symbol (sym->name, sym->ns->parent, 1, &s);
1649 procedure_kind (gfc_symbol *sym)
1651 if (generic_sym (sym))
1654 if (specific_sym (sym))
1666 check_assumed_size_reference (gfc_symbol *sym, gfc_expr *e)
1668 if (need_full_assumed_size || !(sym->as && sym->as->type == AS_ASSUMED_SIZE))
1681 "array %qs at %L", sym->name, &e->where);
1702 if (e->symtree && check_assumed_size_reference (e->symtree->n.sym, e))
1727 gfc_symbol *sym;
1730 sym = e->symtree->n.sym;
1732 for (p = sym->generic; p; p = p->next)
1733 if (strcmp (sym->name, p->sym->name) == 0)
1735 e->symtree = gfc_find_symtree (p->sym->ns->sym_root,
1736 sym->name);
1741 gfc_error ("%qs at %L is ambiguous", e->symtree->n.sym->name,
1746 "argument at %L", sym->name, &e->where);
1752 /* See if a call to sym could possibly be a not allowed RECURSION because of
1753 a missing RECURSIVE declaration. This means that either sym is the current
1754 context itself, or sym is the parent of a contained procedure calling its
1756 This also works if sym is an ENTRY. */
1759 is_illegal_recursion (gfc_symbol* sym, gfc_namespace* context)
1765 if (sym->attr.flavor == FL_PROGRAM
1766 || gfc_fl_struct (sym->attr.flavor))
1770 if (sym->attr.entry && sym->ns->entries)
1771 proc_sym = sym->ns->entries->sym;
1773 proc_sym = sym;
1775 /* If sym is RECURSIVE, all is well of course. */
1787 context_proc = (real_context->entries ? real_context->entries->sym
1803 /* A call from sym's body to itself is recursion, of course. */
1807 /* The same is true if context is a contained procedure and sym the
1814 parent_proc = (context->parent->entries ? context->parent->entries->sym
1829 gfc_resolve_intrinsic (gfc_symbol *sym, locus *loc)
1834 if (sym->resolve_symbol_called >= 2)
1837 sym->resolve_symbol_called = 2;
1840 if (sym->from_intmod && sym->ts.type != BT_UNKNOWN)
1848 if (sym->intmod_sym_id && sym->attr.subroutine)
1850 gfc_isym_id id = gfc_isym_id_by_intmod_sym (sym);
1853 else if (sym->intmod_sym_id)
1855 gfc_isym_id id = gfc_isym_id_by_intmod_sym (sym);
1858 else if (!sym->attr.subroutine)
1859 isym = gfc_find_function (sym->name);
1861 if (isym && !sym->attr.subroutine)
1863 if (sym->ts.type != BT_UNKNOWN && warn_surprising
1864 && !sym->attr.implicit_type)
1867 " ignored", sym->name, &sym->declared_at);
1869 if (!sym->attr.function &&
1870 !gfc_add_function(&sym->attr, sym->name, loc))
1873 sym->ts = isym->ts;
1875 else if (isym || (isym = gfc_find_subroutine (sym->name)))
1877 if (sym->ts.type != BT_UNKNOWN && !sym->attr.implicit_type)
1880 " specifier", sym->name, &sym->declared_at);
1884 if (!sym->attr.subroutine &&
1885 !gfc_add_subroutine(&sym->attr, sym->name, loc))
1890 gfc_error ("%qs declared INTRINSIC at %L does not exist", sym->name,
1891 &sym->declared_at);
1895 gfc_copy_formal_args_intr (sym, isym, NULL);
1897 sym->attr.pure = isym->pure;
1898 sym->attr.elemental = isym->elemental;
1901 if (!gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at))
1907 sym->name, &sym->declared_at, symstd);
1921 gfc_symbol* sym;
1927 sym = expr->symtree->n.sym;
1929 if (sym->attr.intrinsic)
1930 gfc_resolve_intrinsic (sym, &expr->where);
1932 if (sym->attr.flavor != FL_PROCEDURE
1933 || (sym->attr.function && sym->result == sym))
1938 if (is_illegal_recursion (sym, gfc_current_ns))
1941 " %<-frecursive%>", sym->name, &expr->where);
1976 gfc_symbol *sym;
2007 && e->symtree->n.sym->attr.generic
2025 sym = e->symtree->n.sym;
2027 if (sym->attr.flavor == FL_PROCEDURE && is_dt_name (sym->name))
2030 "argument at %L", sym->name, &e->where);
2034 if (sym->attr.flavor == FL_PROCEDURE
2035 || sym->attr.intrinsic
2036 || sym->attr.external)
2042 if (gfc_is_intrinsic (sym, sym->attr.subroutine, e->where))
2043 sym->attr.intrinsic = 1;
2045 if (sym->attr.proc == PROC_ST_FUNCTION)
2048 "actual argument", sym->name, &e->where);
2051 actual_ok = gfc_intrinsic_actual_ok (sym->name,
2052 sym->attr.subroutine);
2053 if (sym->attr.intrinsic && actual_ok == 0)
2056 "actual argument", sym->name, &e->where);
2059 if (sym->attr.contained && !sym->attr.use_assoc
2060 && sym->ns->proc_name->attr.flavor != FL_MODULE)
2064 sym->name, &e->where))
2068 if (sym->attr.elemental && !sym->attr.intrinsic)
2071 "allowed as an actual argument at %L", sym->name,
2077 if (sym->attr.generic && count_specific_procs (e) != 1)
2081 sym = e->symtree->n.sym;
2086 if (gfc_is_function_return_value (sym, sym->ns))
2090 if (sym->ts.type == BT_UNKNOWN && sym->attr.intrinsic)
2094 isym = gfc_find_function (sym->name);
2098 "for the reference %qs at %L", sym->name,
2102 sym->ts = isym->ts;
2103 sym->attr.intrinsic = 1;
2104 sym->attr.function = 1;
2114 if (was_declared (sym) || sym->ns->parent == NULL)
2117 if (gfc_find_sym_tree (sym->name, sym->ns->parent, 1, &parent_st))
2119 gfc_error ("Symbol %qs at %L is ambiguous", sym->name, &e->where);
2126 sym = parent_st->n.sym;
2129 if (sym->attr.flavor == FL_PROCEDURE
2130 || sym->attr.intrinsic
2131 || sym->attr.external)
2140 e->ts = sym->ts;
2141 if ((sym->as != NULL && sym->ts.type != BT_CLASS)
2142 || (sym->ts.type == BT_CLASS && sym->attr.class_ok
2143 && CLASS_DATA (sym)->as))
2145 e->rank = sym->ts.type == BT_CLASS
2146 ? CLASS_DATA (sym)->as->rank : sym->as->rank;
2150 e->ref->u.ar.as = sym->ts.type == BT_CLASS
2151 ? CLASS_DATA (sym)->as : sym->as;
2205 if (e->symtree->n.sym->attr.proc == PROC_INTERNAL)
2289 esym = c->symtree->n.sym;
2305 && arg->expr->symtree->n.sym->attr.optional)
2337 if (eformal->sym && eformal->sym->attr.optional)
2352 && arg->expr->symtree->n.sym->attr.optional
2366 && !a->expr->symtree->n.sym->attr.optional)
2379 arg->expr->symtree->n.sym->name, &arg->expr->where);
2408 if (eformal->sym
2409 && (eformal->sym->attr.intent == INTENT_OUT
2410 || eformal->sym->attr.intent == INTENT_INOUT)
2416 (eformal->sym->attr.intent == INTENT_OUT) ? "OUT"
2417 : "INOUT", eformal->sym->name, esym->name);
2440 not_in_recursive (gfc_symbol *sym, gfc_namespace *gsym_ns)
2445 if (sym->ns == gsym_ns)
2448 if (sym->ns->parent && sym->ns->parent == gsym_ns)
2455 not_entry_self_reference (gfc_symbol *sym, gfc_namespace *gsym_ns)
2463 if (strcmp (sym->name, entry->sym->name) == 0)
2466 sym->ns->proc_name->name) == 0)
2469 if (sym->ns->parent
2471 sym->ns->parent->proc_name->name) == 0)
2483 gfc_explicit_interface_required (gfc_symbol *sym, char *errmsg, int err_len)
2485 gfc_formal_arglist *arg = gfc_sym_get_dummy_args (sym);
2489 if (!arg->sym)
2492 if (arg->sym->attr.allocatable) /* (2a) */
2497 else if (arg->sym->attr.asynchronous)
2502 else if (arg->sym->attr.optional)
2507 else if (arg->sym->attr.pointer)
2512 else if (arg->sym->attr.target)
2517 else if (arg->sym->attr.value)
2522 else if (arg->sym->attr.volatile_)
2527 else if (arg->sym->as && arg->sym->as->type == AS_ASSUMED_SHAPE) /* (2b) */
2532 else if (arg->sym->as && arg->sym->as->type == AS_ASSUMED_RANK) /* TS 29113, 6.2. */
2537 else if (arg->sym->attr.codimension) /* (2c) */
2547 else if (arg->sym->ts.type == BT_CLASS) /* (2e) */
2552 else if (arg->sym->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK))
2557 else if (arg->sym->ts.type == BT_ASSUMED)
2566 if (sym->attr.function)
2568 gfc_symbol *res = sym->result ? sym->result : sym;
2589 if (sym->attr.elemental && !sym->attr.intrinsic) /* (4) */
2594 else if (sym->attr.is_bind_c) /* (5) */
2605 resolve_global_procedure (gfc_symbol *sym, locus *where, int sub)
2614 gsym = gfc_get_gsymbol (sym->binding_label ? sym->binding_label : sym->name,
2615 sym->binding_label != NULL);
2620 if ((sym->attr.if_source == IFSRC_UNKNOWN
2621 || sym->attr.if_source == IFSRC_IFBODY)
2626 && not_in_recursive (sym, gsym->ns)
2627 && not_entry_self_reference (sym, gsym->ns))
2677 if (strcmp (entry->sym->name, sym->name) == 0)
2679 def_sym = entry->sym;
2685 if (sym->attr.function && !gfc_compare_types (&sym->ts, &def_sym->ts))
2688 sym->name, &sym->declared_at, gfc_typename (&sym->ts),
2693 if (sym->attr.if_source == IFSRC_UNKNOWN
2697 sym->name, &sym->declared_at, reason);
2702 if (!gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1,
2715 sym->name, &sym->declared_at, reason);
2716 sym->error = 1;
2740 resolve_generic_f0 (gfc_expr *expr, gfc_symbol *sym)
2744 if (sym->attr.generic)
2746 s = gfc_search_interface (sym->generic, 0, &expr->value.function.actual);
2771 if (sym->attr.intrinsic)
2781 gfc_symbol *sym;
2785 sym = expr->symtree->n.sym;
2789 m = resolve_generic_f0 (expr, sym);
2797 for (intr = sym->generic; intr; intr = intr->next)
2798 if (gfc_fl_struct (intr->sym->attr.flavor))
2801 if (sym->ns->parent == NULL)
2803 gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
2805 if (sym == NULL)
2807 if (!generic_sym (sym))
2813 if (sym && !intr && !gfc_is_intrinsic (sym, 0, expr->where))
2818 expr->symtree->n.sym->name, &expr->where);
2821 "at %L", expr->symtree->n.sym->name, &expr->where);
2827 if (!gfc_convert_to_structure_constructor (expr, intr->sym, NULL,
2841 "specific intrinsic interface", expr->symtree->n.sym->name,
2851 resolve_specific_f0 (gfc_symbol *sym, gfc_expr *expr)
2855 if (sym->attr.external || sym->attr.if_source == IFSRC_IFBODY)
2857 if (sym->attr.dummy)
2859 sym->attr.proc = PROC_DUMMY;
2863 sym->attr.proc = PROC_EXTERNAL;
2867 if (sym->attr.proc == PROC_MODULE
2868 || sym->attr.proc == PROC_ST_FUNCTION
2869 || sym->attr.proc == PROC_INTERNAL)
2872 if (sym->attr.intrinsic)
2879 "with an intrinsic", sym->name, &expr->where);
2887 gfc_procedure_use (sym, &expr->value.function.actual, &expr->where);
2889 if (sym->result)
2890 expr->ts = sym->result->ts;
2892 expr->ts = sym->ts;
2893 expr->value.function.name = sym->name;
2894 expr->value.function.esym = sym;
2895 /* Prevent crash when sym->ts.u.derived->components is not set due to previous
2897 if (sym->ts.type == BT_CLASS && !CLASS_DATA (sym))
2899 if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->as)
2900 expr->rank = CLASS_DATA (sym)->as->rank;
2901 else if (sym->as != NULL)
2902 expr->rank = sym->as->rank;
2911 gfc_symbol *sym;
2914 sym = expr->symtree->n.sym;
2918 m = resolve_specific_f0 (sym, expr);
2924 if (sym->ns->parent == NULL)
2927 gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
2929 if (sym == NULL)
2934 expr->symtree->n.sym->name, &expr->where);
2939 /* Recursively append candidate SYM to CANDIDATES. Store the number of
2943 lookup_function_fuzzy_find_candidates (gfc_symtree *sym,
2949 if (sym == NULL)
2951 if ((sym->n.sym->ts.type != BT_UNKNOWN || sym->n.sym->attr.external)
2952 && sym->n.sym->attr.flavor == FL_PROCEDURE)
2953 vec_push (candidates, candidates_len, sym->name);
2955 p = sym->left;
2959 p = sym->right;
2982 gfc_symbol *sym;
2985 sym = expr->symtree->n.sym;
2987 if (sym->attr.dummy)
2989 sym->attr.proc = PROC_DUMMY;
2990 expr->value.function.name = sym->name;
2996 if (gfc_is_intrinsic (sym, 0, expr->where))
3005 if (sym->attr.flavor == FL_PROCEDURE
3006 && sym->attr.implicit_type
3007 && sym->ns
3008 && sym->ns->has_implicit_none_export)
3011 "for symbol %qs at %L", sym->name, &sym->declared_at);
3012 sym->error = 1;
3018 sym->attr.proc = PROC_EXTERNAL;
3019 expr->value.function.name = sym->name;
3020 expr->value.function.esym = expr->symtree->n.sym;
3022 if (sym->as != NULL)
3023 expr->rank = sym->as->rank;
3029 gfc_procedure_use (sym, &expr->value.function.actual, &expr->where);
3031 if (sym->ts.type != BT_UNKNOWN)
3032 expr->ts = sym->ts;
3035 ts = gfc_get_default_type (sym->name, sym->ns);
3040 = gfc_lookup_function_fuzzy (sym->name, sym->ns->sym_root);
3044 sym->name, &expr->where, guessed);
3047 sym->name, &expr->where);
3060 is_external_proc (gfc_symbol *sym)
3062 if (!sym->attr.dummy && !sym->attr.contained
3063 && !gfc_is_intrinsic (sym, sym->attr.subroutine, sym->declared_at)
3064 && sym->attr.proc != PROC_ST_FUNCTION
3065 && !sym->attr.proc_pointer
3066 && !sym->attr.use_assoc
3067 && sym->name)
3089 && e->symtree->n.sym != NULL
3090 && e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION)
3091 return pure_stmt_function (e, e->symtree->n.sym);
3137 impure_stmt_fcn (gfc_expr *e, gfc_symbol *sym,
3146 || e->symtree->n.sym == sym
3147 || e->symtree->n.sym->attr.proc == PROC_ST_FUNCTION)
3155 pure_stmt_function (gfc_expr *e, gfc_symbol *sym)
3157 return gfc_traverse_expr (e, sym, impure_stmt_fcn, 0) ? 0 : 1;
3196 a call to procedure SYM. */
3199 update_current_proc_array_outer_dependency (gfc_symbol *sym)
3206 if (sibling->proc_name == sym)
3213 /* If SYM has references to outer arrays, so has the procedure calling
3214 SYM. If SYM is a procedure pointer, we can assume the worst. */
3215 if ((sym->attr.array_outer_dependency || sym->attr.proc_pointer)
3228 gfc_symbol *sym;
3234 sym = NULL;
3236 sym = expr->symtree->n.sym;
3244 if (sym && sym->attr.intrinsic
3245 && (sym->intmod_sym_id == GFC_ISYM_CAF_GET
3246 || sym->intmod_sym_id == GFC_ISYM_CAF_SEND))
3251 gfc_error ("Unexpected junk after %qs at %L", expr->symtree->n.sym->name,
3256 if (sym && sym->attr.intrinsic
3257 && !gfc_resolve_intrinsic (sym, &expr->where))
3260 if (sym && (sym->attr.flavor == FL_VARIABLE || sym->attr.subroutine))
3262 gfc_error ("%qs at %L is not a function", sym->name, &expr->where);
3268 if (sym && sym->attr.abstract && !expr->value.function.esym)
3271 sym->name, &expr->where);
3277 if (sym && sym->attr.abstract && sym->attr.function
3278 && sym->result->ts.u.cl
3279 && sym->result->ts.u.cl->length == NULL
3280 && !sym->result->ts.deferred)
3283 "character length result (F2008: C418)", sym->name,
3284 &sym->declared_at);
3292 if (expr->symtree && expr->symtree->n.sym)
3293 p = expr->symtree->n.sym->attr.proc;
3297 no_formal_args = sym && is_external_proc (sym)
3298 && gfc_sym_get_dummy_args (sym) == NULL;
3313 if (sym && is_external_proc (sym))
3314 resolve_global_procedure (sym, &expr->where, 0);
3316 if (sym && sym->ts.type == BT_CHARACTER
3317 && sym->ts.u.cl
3318 && sym->ts.u.cl->length == NULL
3319 && !sym->attr.dummy
3320 && !sym->ts.deferred
3322 && !sym->attr.contained)
3327 sym->name, &expr->where);
3337 expr->ts = sym->ts;
3344 switch (procedure_kind (sym))
3453 esym->name, &expr->where, esym->ns->entries->sym->name);
3475 if (expr->symtree->n.sym->result
3476 && expr->symtree->n.sym->result->ts.type != BT_UNKNOWN
3477 && !expr->symtree->n.sym->result->attr.proc_pointer)
3478 expr->ts = expr->symtree->n.sym->result->ts;
3486 update_current_proc_array_outer_dependency (sym);
3496 sym->name, &expr->where);
3504 pure_subroutine (gfc_symbol *sym, const char *name, locus *loc)
3506 if (gfc_pure (sym))
3533 resolve_generic_s0 (gfc_code *c, gfc_symbol *sym)
3537 if (sym->attr.generic)
3539 s = gfc_search_interface (sym->generic, 1, &c->ext.actual);
3551 if (sym->attr.intrinsic)
3561 gfc_symbol *sym;
3564 sym = c->symtree->n.sym;
3568 m = resolve_generic_s0 (c, sym);
3575 if (sym->ns->parent == NULL)
3577 gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
3579 if (sym == NULL)
3581 if (!generic_sym (sym))
3587 sym = c->symtree->n.sym;
3589 if (!gfc_is_intrinsic (sym, 1, c->loc))
3592 sym->name, &c->loc);
3601 "intrinsic subroutine interface", sym->name, &c->loc);
3610 resolve_specific_s0 (gfc_code *c, gfc_symbol *sym)
3614 if (sym->attr.external || sym->attr.if_source == IFSRC_IFBODY)
3616 if (sym->attr.dummy)
3618 sym->attr.proc = PROC_DUMMY;
3622 sym->attr.proc = PROC_EXTERNAL;
3626 if (sym->attr.proc == PROC_MODULE || sym->attr.proc == PROC_INTERNAL)
3629 if (sym->attr.intrinsic)
3636 "with an intrinsic", sym->name, &c->loc);
3644 gfc_procedure_use (sym, &c->ext.actual, &c->loc);
3646 c->resolved_sym = sym;
3647 if (!pure_subroutine (sym, sym->name, &c->loc))
3657 gfc_symbol *sym;
3660 sym = c->symtree->n.sym;
3664 m = resolve_specific_s0 (c, sym);
3670 if (sym->ns->parent == NULL)
3673 gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
3675 if (sym == NULL)
3679 sym = c->symtree->n.sym;
3681 sym->name, &c->loc);
3692 gfc_symbol *sym;
3694 sym = c->symtree->n.sym;
3696 if (sym->attr.dummy)
3698 sym->attr.proc = PROC_DUMMY;
3704 if (gfc_is_intrinsic (sym, 1, c->loc))
3714 gfc_procedure_use (sym, &c->ext.actual, &c->loc);
3716 c->resolved_sym = sym;
3718 return pure_subroutine (sym, sym->name, &c->loc);
3731 gfc_symbol *csym, *sym;
3734 csym = c->symtree ? c->symtree->n.sym : NULL;
3747 sym = st ? st->n.sym : NULL;
3748 if (sym && csym != sym
3749 && sym->ns == gfc_current_ns
3750 && sym->attr.flavor == FL_PROCEDURE
3751 && sym->attr.contained)
3753 sym->refs++;
3755 c->symtree->n.sym = sym;
3758 csym = c->symtree->n.sym;
3779 csym->name, &c->loc, csym->ns->entries->sym->name);
3942 if (!e->symtree || !e->symtree->n.sym)
3944 gfc_symbol *sym;
3946 sym = e->symtree->n.sym;
3947 sym->result = sym;
3948 sym->attr.flavor = FL_PROCEDURE;
3949 sym->attr.function = 1;
3950 sym->attr.elemental = 1;
3951 sym->attr.pure = 1;
3952 sym->attr.referenced = 1;
3953 gfc_intrinsic_symbol (sym);
3954 gfc_commit_symbol (sym);
4408 e->value.op.uop->op->sym->attr.referenced = 1;
4984 resolve_assoc_var (gfc_symbol* sym, bool resolve_target);
4994 if (e->symtree->n.sym->assoc)
4996 if (e->symtree->n.sym->assoc->target)
4997 gfc_resolve_expr (e->symtree->n.sym->assoc->target);
4998 resolve_assoc_var (e->symtree->n.sym, false);
5001 if (e->symtree->n.sym->ts.type == BT_CLASS)
5003 as = CLASS_DATA (e->symtree->n.sym)->as;
5007 as = e->symtree->n.sym->as;
5075 && e->symtree->n.sym->ts.type == BT_DERIVED)
5278 else if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.dummy)
5295 ts = &e->symtree->n.sym->ts;
5562 e->rank = ((e->symtree == NULL || e->symtree->n.sym->as == NULL)
5563 ? 0 : e->symtree->n.sym->as->rank);
5655 gfc_symbol *sym;
5662 sym = e->symtree->n.sym;
5666 if (sym->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK))
5671 "be used as actual argument", sym->name, &e->where);
5681 "as actual argument", sym->name, &e->where);
5692 sym->name, &e->where);
5697 else if (((sym->ts.type == BT_CLASS && sym->attr.class_ok
5698 && sym->ts.u.derived && CLASS_DATA (sym)
5699 && CLASS_DATA (sym)->as
5700 && CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
5701 || (sym->ts.type != BT_CLASS && sym->as
5702 && sym->as->type == AS_ASSUMED_RANK))
5703 && !sym->attr.select_rank_temporary)
5710 "actual argument", sym->name, &e->where);
5721 sym->name, &e->where);
5726 if ((sym->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK)) && e->ref
5731 "a subobject reference", sym->name, &e->ref->u.ar.where);
5740 "reference", sym->name, &e->ref->u.ar.where);
5745 if (((sym->ts.type == BT_CLASS && sym->attr.class_ok
5746 && sym->ts.u.derived && CLASS_DATA (sym)
5747 && CLASS_DATA (sym)->as
5748 && CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
5749 || (sym->ts.type != BT_CLASS && sym->as
5750 && sym->as->type == AS_ASSUMED_RANK))
5756 "reference", sym->name, &e->ref->u.ar.where);
5764 if (sym->assoc && e->rank == 0 && e->ref && sym->ts.type == BT_CLASS
5765 && sym->assoc->target && sym->assoc->target->ts.type == BT_CLASS
5766 && sym->assoc->target->ts.u.derived
5767 && CLASS_DATA (sym->assoc->target)
5768 && CLASS_DATA (sym->assoc->target)->as)
5776 ref->u.c.sym = sym->ts.u.derived;
5790 if (sym->assoc && !(sym->ts.type == BT_CLASS && e->rank == 0))
5792 if (sym->ts.type == BT_CLASS)
5794 if (!sym->attr.dimension && e->ref && e->ref->type == REF_ARRAY)
5796 else if (sym->attr.dimension && (!e->ref || e->ref->type != REF_ARRAY))
5804 if (sym->as)
5806 ref->u.ar.as = sym->as;
5807 ref->u.ar.dimen = sym->as->rank;
5815 if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.generic)
5816 sym->ts.u.derived = gfc_find_dt_in_generic (sym->ts.u.derived);
5820 if (sym->assoc && sym->attr.dimension && !e->ref)
5831 if (sym->assoc && sym->ts.type == BT_CLASS && sym->ts.u.derived
5832 && CLASS_DATA (sym)
5833 && CLASS_DATA (sym)->attr.dimension
5875 if (sym->attr.flavor == FL_PROCEDURE
5876 && (!sym->attr.function
5877 || (sym->attr.function && sym->result
5878 && sym->result->attr.proc_pointer
5879 && !sym->result->attr.function)))
5885 if (sym->ts.type != BT_UNKNOWN)
5887 else if (sym->attr.flavor == FL_PROCEDURE
5888 && sym->attr.function && sym->result
5889 && sym->result->ts.type != BT_UNKNOWN
5890 && sym->result->attr.proc_pointer)
5891 e->ts = sym->result->ts;
5895 if (!gfc_set_default_type (sym, 1, sym->ns))
5897 e->ts = sym->ts;
5900 if (check_assumed_size_reference (sym, e))
5906 && current_entry_id == sym->entry_id
5917 if (sym->attr.dummy && sym->ns == gfc_current_ns)
5924 for (formal = entry->sym->formal; formal; formal = formal->next)
5926 if (formal->sym && sym->name == formal->sym->name)
5940 sym->name, &cs_base->current->loc);
5944 sym->name, &cs_base->current->loc);
5952 if (sym->ts.type == BT_CHARACTER
5953 && !gfc_resolve_expr (sym->ts.u.cl->length))
5956 if (sym->as)
5957 for (n = 0; n < sym->as->rank; n++)
5959 if (!gfc_resolve_expr (sym->as->lower[n]))
5961 if (!gfc_resolve_expr (sym->as->upper[n]))
5968 sym->entry_id = current_entry_id + 1;
5973 if (sym->attr.flavor == FL_VARIABLE
5975 && (gfc_current_ns->parent == sym->ns
5977 && gfc_current_ns->parent->parent == sym->ns)))
5978 sym->attr.host_assoc = 1;
5981 && sym->attr.dimension
5982 && (sym->ns != gfc_current_ns
5983 || sym->attr.use_assoc
5984 || sym->attr.in_common))
6021 c = ref2 ? ref2->u.c.component : e->symtree->n.sym->components;
6039 if (sym->attr.ext_attr & (1 << EXT_ATTR_DEPRECATED) && sym != sym->result)
6042 sym->name, &e->where);
6046 if (e->rank == 0 && sym->as && sym->attr.flavor == FL_PARAMETER)
6069 gfc_symbol *sym, *old_sym;
6080 || e->symtree->n.sym == NULL
6084 old_sym = e->symtree->n.sym;
6091 gfc_find_symbol (e->symtree->name, gfc_current_ns, 1, &sym);
6093 if (sym && old_sym != sym
6094 && sym->ts.type == old_sym->ts.type
6095 && sym->attr.flavor == FL_PROCEDURE
6096 && sym->attr.contained)
6130 && sym->attr.proc == PROC_INTERNAL)
6134 "procedure of the same name", sym->name,
6159 e->rank = sym->as ? sym->as->rank : 0;
6163 sym->refs++;
6168 else if (sym && old_sym != sym
6170 && sym->ts.type == BT_UNKNOWN
6172 && sym->attr.flavor == FL_PROCEDURE
6174 && sym->ns->parent == old_sym->ns
6175 && sym->ns->proc_name
6176 && sym->ns->proc_name->attr.proc != PROC_MODULE
6177 && (sym->ns->proc_name->attr.flavor == FL_LABEL
6178 || sym->ns->proc_name->attr.flavor == FL_PROCEDURE))
6582 declared = e->symtree->n.sym->ts.u.derived;
6624 target = g->specific->u.specific->n.sym;
6695 && c->expr1->value.compcall.tbp->u.specific->n.sym
6696 && c->expr1->value.compcall.tbp->u.specific->n.sym->attr.subroutine)
6774 if (e->value.compcall.tbp->u.specific->n.sym->as)
6775 e->rank = e->value.compcall.tbp->u.specific->n.sym->as->rank;
6785 e->value.function.esym = target->n.sym;
6788 e->ts = target->n.sym->ts;
6798 static bool resolve_fl_derived (gfc_symbol *sym);
6877 || (!class_ref && st->n.sym->ts.type != BT_CLASS))
7007 || (!class_ref && st->n.sym->ts.type != BT_CLASS))
7056 c->resolved_sym = c->expr1->symtree->n.sym;
7140 && (con->expr->symtree->n.sym->attr.flavor == FL_PARAMETER
7141 || con->expr->symtree->n.sym->attr.flavor == FL_VARIABLE))
7164 if (e->symtree->n.sym->ns->proc_name
7165 && e->symtree->n.sym->ns->proc_name->formal)
7166 s = e->symtree->n.sym->ns->proc_name->formal->sym;
7169 st = gfc_find_symtree (s->ns->sym_root, e->symtree->n.sym->name);
7172 && st->n.sym != NULL
7173 && st->n.sym->attr.dummy)
7203 && e->symtree->n.sym->attr.dummy)
7300 && e->symtree->n.sym->attr.select_rank_temporary
7301 && UNLIMITED_POLY (e->symtree->n.sym))
7454 forall_index (gfc_expr *expr, gfc_symbol *sym, int *f)
7462 if (expr->symtree->n.sym == sym)
7475 Returns true if SYM is found in EXPR. */
7478 find_forall_index (gfc_expr *expr, gfc_symbol *sym, int f)
7480 if (gfc_traverse_expr (expr, sym, forall_index, f))
7538 if (find_forall_index (iter2->start, iter->var->symtree->n.sym, 0)
7539 || find_forall_index (iter2->end, iter->var->symtree->n.sym, 0)
7540 || find_forall_index (iter2->stride, iter->var->symtree->n.sym, 0))
7554 derived_inaccessible (gfc_symbol *sym)
7558 if (sym->attr.use_assoc && sym->attr.private_comp)
7561 for (c = sym->components; c; c = c->next)
7566 && sym == c->ts.u.derived)
7586 gfc_symbol *sym;
7596 sym = e->symtree->n.sym;
7597 unlimited = UNLIMITED_POLY(sym);
7599 if (sym->ts.type == BT_CLASS)
7601 allocatable = CLASS_DATA (sym)->attr.allocatable;
7602 pointer = CLASS_DATA (sym)->attr.class_pointer;
7606 allocatable = sym->attr.allocatable;
7607 pointer = sym->attr.pointer;
7670 /* Returns true if the expression e contains a reference to the symbol sym. */
7672 sym_in_expr (gfc_expr *e, gfc_symbol *sym, int *f ATTRIBUTE_UNUSED)
7674 if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym == sym)
7681 gfc_find_sym_in_expr (gfc_symbol *sym, gfc_expr *e)
7683 return gfc_traverse_expr (e, sym, sym_in_expr, 0);
7824 gfc_symbol *sym = NULL;
7846 sym = e->symtree->n.sym;
7864 if (sym->ts.type == BT_CLASS && CLASS_DATA (sym))
7866 allocatable = CLASS_DATA (sym)->attr.allocatable;
7867 pointer = CLASS_DATA (sym)->attr.class_pointer;
7868 dimension = CLASS_DATA (sym)->attr.dimension;
7869 codimension = CLASS_DATA (sym)->attr.codimension;
7870 is_abstract = CLASS_DATA (sym)->attr.abstract;
7874 allocatable = sym->attr.allocatable;
7875 pointer = sym->attr.pointer;
7876 dimension = sym->attr.dimension;
7877 codimension = sym->attr.codimension;
8010 "type-spec or source-expr", sym->name, &e->where);
8029 sym->name, &e->where);
8215 sym = a->expr->symtree->n.sym;
8218 if (gfc_bt_struct (sym->ts.type) || sym->ts.type == BT_CLASS)
8222 && gfc_find_sym_in_expr (sym, ar->start[i]))
8224 && gfc_find_sym_in_expr (sym, ar->end[i])))
8228 "itself allocated", sym->name, &ar->where);
8293 if (p->expr->symtree->n.sym->name == stat->symtree->n.sym->name)
8349 if (p->expr->symtree->n.sym->name == errmsg->symtree->n.sym->name)
8385 if (pe->symtree->n.sym->name == qe->symtree->n.sym->name)
9043 gfc_type_is_extensible (gfc_symbol *sym)
9045 return !(sym->attr.is_bind_c || sym->attr.sequence
9046 || (sym->attr.is_class
9047 sym->components->ts.u.derived->attr.unlimited_polymorphic));
9058 resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
9062 gcc_assert (sym->assoc);
9063 gcc_assert (sym->attr.flavor == FL_VARIABLE);
9068 target = sym->assoc->target;
9071 gcc_assert (!sym->assoc->dangling);
9082 tsym = target->symtree->n.sym;
9104 for (gfc_namespace *ns = sym->ns; ns; ns = ns->parent)
9118 sym->attr.asynchronous = tsym->attr.asynchronous;
9119 sym->attr.volatile_ = tsym->attr.volatile_;
9121 sym->attr.target = tsym->attr.target
9124 sym->attr.subref_array_pointer = 1;
9147 if (sym->ts.type == BT_UNKNOWN)
9148 sym->ts = target->ts;
9150 gcc_assert (sym->ts.type != BT_UNKNOWN);
9153 sym->assoc->variable = (target->expr_type == EXPR_VARIABLE
9157 if (sym->attr.dimension && target->rank == 0)
9161 if (sym->ts.type != BT_CHARACTER)
9163 sym->name, &sym->declared_at);
9164 sym->attr.dimension = 0;
9181 if (target->rank != 0 && !sym->attr.select_rank_temporary)
9186 if (sym->ts.type != BT_CLASS && (!sym->as || sym->assoc->rankguessed))
9188 if (!sym->as)
9189 sym->as = gfc_get_array_spec ();
9190 as = sym->as;
9194 sym->attr.dimension = 1;
9196 sym->attr.codimension = 1;
9198 else if (sym->ts.type == BT_CLASS
9199 && CLASS_DATA (sym)
9200 && (!CLASS_DATA (sym)->as || sym->assoc->rankguessed))
9202 if (!CLASS_DATA (sym)->as)
9203 CLASS_DATA (sym)->as = gfc_get_array_spec ();
9204 as = CLASS_DATA (sym)->as;
9208 CLASS_DATA (sym)->attr.dimension = 1;
9210 CLASS_DATA (sym)->attr.codimension = 1;
9213 else if (!sym->attr.select_rank_temporary)
9215 /* target's rank is 0, but the type of the sym is still array valued,
9217 if (sym->ts.type == BT_CLASS && sym->ts.u.derived
9218 && CLASS_DATA (sym) && CLASS_DATA (sym)->as)
9248 sym->ts = *ts;
9249 sym->ts.type = BT_CLASS;
9250 attr = CLASS_DATA (sym) ? CLASS_DATA (sym)->attr : sym->attr;
9255 if (!gfc_build_class_symbol (&sym->ts, &attr, &as))
9258 c = gfc_find_component (sym->ts.u.derived, "_vptr", true, true, NULL);
9260 c->ts.u.derived = gfc_find_derived_vtab (sym->ts.u.derived);
9261 CLASS_DATA (sym)->attr.pointer = 1;
9262 CLASS_DATA (sym)->attr.class_pointer = 1;
9263 gfc_set_sym_referenced (sym->ts.u.derived);
9264 gfc_commit_symbol (sym->ts.u.derived);
9274 sym->attr.associate_var = 1;
9277 if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary)
9279 if (!sym->ts.u.cl)
9280 sym->ts.u.cl = target->ts.u.cl;
9282 if (sym->ts.deferred
9283 && sym->ts.u.cl == target->ts.u.cl)
9285 sym->ts.u.cl = gfc_new_charlen (sym->ns, NULL);
9286 sym->ts.deferred = 1;
9289 if (!sym->ts.u.cl->length
9290 && !sym->ts.deferred
9293 sym->ts.u.cl->length =
9297 else if ((!sym->ts.u.cl->length
9298 || sym->ts.u.cl->length->expr_type != EXPR_CONSTANT)
9301 if (!sym->ts.deferred)
9303 sym->ts.u.cl = gfc_new_charlen (sym->ns, NULL);
9304 sym->ts.deferred = 1;
9309 sym->attr.allocatable = 1;
9314 if (sym->ts.type == BT_CLASS && gfc_expr_attr (target).class_ok)
9315 sym->attr.class_ok = 1;
9330 gfc_symbol *sym1 = (*expr1)->symtree->n.sym;
9331 gfc_symbol *sym2 = expr2 ? expr2->symtree->n.sym : NULL;
9368 loc_call->symtree->n.sym->attr.flavor = FL_PROCEDURE;
9369 loc_call->symtree->n.sym->attr.intrinsic = 1;
9370 loc_call->symtree->n.sym->result = loc_call->symtree->n.sym;
9371 gfc_commit_symbol (loc_call->symtree->n.sym);
9410 if (!code->expr1->symtree->n.sym->attr.class_ok)
9423 if (code->expr1->symtree->n.sym->attr.untyped)
9424 code->expr1->symtree->n.sym->ts = ref2->u.c.component->ts;
9429 if (code->expr1->symtree->n.sym->attr.untyped)
9430 code->expr1->symtree->n.sym->ts = code->expr2->ts;
9566 code->expr1->symtree->n.sym->assoc = assoc;
9568 resolve_assoc_var (code->expr1->symtree->n.sym, false);
9684 gcc_assert (st->n.sym->assoc);
9685 st->n.sym->assoc->target = gfc_get_variable_expr (selector_expr->symtree);
9686 st->n.sym->assoc->target->where = selector_expr->where;
9689 gfc_add_data_component (st->n.sym->assoc->target);
9692 fixup_array_ref (&st->n.sym->assoc->target, NULL, rank, ref);
9703 if (st->n.sym->assoc->dangling)
9705 new_st->ext.block.assoc = st->n.sym->assoc;
9706 st->n.sym->assoc->dangling = 0;
9709 resolve_assoc_var (st->n.sym, false);
9835 it requires that the sym->assoc of selectors is set already. */
9875 code->expr1->symtree->n.sym->assoc = assoc;
9877 resolve_assoc_var (code->expr1->symtree->n.sym, false);
9981 gcc_assert (st->n.sym->assoc);
9983 st->n.sym->assoc->target = gfc_get_variable_expr (selector_expr->symtree);
9984 st->n.sym->assoc->target->where = selector_expr->where;
9994 if (st->n.sym->assoc->dangling)
9996 new_st->ext.block.assoc = st->n.sym->assoc;
9997 st->n.sym->assoc->dangling = 0;
10000 resolve_assoc_var (st->n.sym, false);
10018 gfc_symbol *sym, *derived;
10055 ? &exp->ts : &exp->symtree->n.sym->ts;
10078 sym = exp->symtree->n.sym->ns->proc_name;
10081 if (sym && sym == dtio_sub && sym->formal
10082 && sym->formal->sym == exp->symtree->n.sym
10085 if (!sym->attr.recursive)
10088 sym->name, &sym->declared_at);
10153 sym = exp->symtree->n.sym;
10155 if (sym->as != NULL && sym->as->type == AS_ASSUMED_SIZE && exp->ref
10296 lock_type = symtree->n.sym;
10302 lock_type = symtree->n.sym;
10313 code->resolved_sym = symtree->n.sym;
10314 symtree->n.sym->attr.flavor = FL_VARIABLE;
10315 symtree->n.sym->attr.referenced = 1;
10316 symtree->n.sym->attr.artificial = 1;
10317 symtree->n.sym->attr.codimension = 1;
10318 symtree->n.sym->ts.type = BT_DERIVED;
10319 symtree->n.sym->ts.u.derived = lock_type;
10320 symtree->n.sym->as = gfc_get_array_spec ();
10321 symtree->n.sym->as->corank = 1;
10322 symtree->n.sym->as->type = AS_EXPLICIT;
10323 symtree->n.sym->as->cotype = AS_EXPLICIT;
10324 symtree->n.sym->as->lower[0] = gfc_get_int_expr (gfc_default_integer_kind,
10606 forall_index = var_expr[n]->symtree->n.sym;
10611 && (code->expr1->symtree->n.sym == forall_index))
10798 if (fa->var->symtree->n.sym == var_expr[i]->symtree->n.sym)
11038 && (*rhsptr)->symtree->n.sym->ts.type == BT_DERIVED
11039 && gfc_has_default_initializer ((*rhsptr)->symtree->n.sym->ts.u.derived)
11040 && (lhs->symtree->n.sym == (*rhsptr)->symtree->n.sym))
11118 && gfc_find_sym_in_expr (lhs->symtree->n.sym,
11131 && (gfc_impure_variable (rhs->symtree->n.sym)
11163 && lhs->symtree->n.sym != gfc_current_ns->proc_name
11164 && lhs->symtree->n.sym->ns != gfc_current_ns)
11171 && (gfc_impure_variable (rhs->symtree->n.sym)
11254 code->resolved_sym = code->symtree->n.sym;
11283 (*ref)->u.c.sym = e->ts.u.derived;
11335 gfc_add_type (tmp->n.sym, &e->ts, NULL);
11338 tmp->n.sym->ts.u.cl->length = gfc_get_int_expr (gfc_charlen_int_kind,
11353 && e->symtree->n.sym->as == aref->as)
11368 tmp->n.sym->attr = gfc_expr_attr (e);
11369 tmp->n.sym->attr.function = 0;
11370 tmp->n.sym->attr.proc_pointer = 0;
11371 tmp->n.sym->attr.result = 0;
11372 tmp->n.sym->attr.flavor = FL_VARIABLE;
11373 tmp->n.sym->attr.dummy = 0;
11374 tmp->n.sym->attr.use_assoc = 0;
11375 tmp->n.sym->attr.intent = INTENT_UNKNOWN;
11379 tmp->n.sym->as = gfc_copy_array_spec (as);
11383 tmp->n.sym->attr.allocatable = 1;
11389 tmp->n.sym->as = gfc_get_array_spec ();
11390 tmp->n.sym->as->type = AS_DEFERRED;
11391 tmp->n.sym->as->rank = e->rank;
11392 tmp->n.sym->attr.allocatable = 1;
11393 tmp->n.sym->attr.dimension = 1;
11396 tmp->n.sym->attr.dimension = 0;
11398 gfc_set_sym_referenced (tmp->n.sym);
11399 gfc_commit_symbol (tmp->n.sym);
11400 e = gfc_lval_expr_from_sym (tmp->n.sym);
11561 if ((*code)->expr1->symtree->n.sym->name[2] != '@')
11620 && dummy_args->sym->attr.intent == INTENT_INOUT)
11637 if ((*code)->expr1->symtree->n.sym->attr.allocatable)
11641 gfc_lval_expr_from_sym ((*code)->expr1->symtree->n.sym);
11663 if ((*code)->expr1->symtree->n.sym->attr.allocatable
11719 if (t1 && (*code)->expr1->symtree->n.sym->attr.allocatable
11726 e = gfc_lval_expr_from_sym ((*code)->expr1->symtree->n.sym);
11783 s = (*code)->expr1->symtree->n.sym;
11799 tmp_ptr_expr->symtree->n.sym->attr.pointer = 1;
11800 tmp_ptr_expr->symtree->n.sym->attr.allocatable = 0;
11811 tmp_ptr_expr->symtree->n.sym->ts.u.cl = tmp_ptr_expr->ts.u.cl;
11854 tmp_expr->symtree->n.sym->ts.u.cl = tmp_expr->ts.u.cl;
11858 tmp_expr->symtree->n.sym->ts.deferred = 1;
12065 || (code->expr1->symtree->n.sym
12066 && (code->expr1->symtree->n.sym->attr.flavor
12070 else if (code->expr1->symtree->n.sym
12071 && code->expr1->symtree->n.sym->attr.assign != 1)
12073 "label at %L", code->expr1->symtree->n.sym->name,
12150 || code->expr1->symtree->n.sym->ts.type != BT_INTEGER
12151 || code->expr1->symtree->n.sym->ts.kind
12153 || code->expr1->symtree->n.sym->attr.flavor == FL_PARAMETER
12154 || code->expr1->symtree->n.sym->as != NULL))
12190 && code->expr2->symtree->n.sym->attr.flavor
12260 gfc_resolve_do_iterator (code, iter->var->symtree->n.sym,
12469 resolve_values (gfc_symbol *sym)
12473 if (sym->value == NULL)
12476 if (sym->attr.ext_attr & (1 << EXT_ATTR_DEPRECATED) && sym->attr.referenced)
12479 sym->name, &sym->declared_at);
12481 if (sym->value->expr_type == EXPR_STRUCTURE)
12482 t= resolve_structure_cons (sym->value, 1);
12484 t = gfc_resolve_expr (sym->value);
12489 gfc_check_assign_symbol (sym, NULL, sym->value);
12508 type 'sym'. These procedures can either have typebound bindings or
12512 gfc_verify_DTIO_procedures (gfc_symbol *sym)
12514 if (!sym || sym->attr.flavor != FL_DERIVED)
12517 gfc_check_dtio_interfaces (sym);
12527 gfc_verify_binding_labels (gfc_symbol *sym)
12532 if (!sym || !sym->attr.is_bind_c || sym->attr.is_iso_c
12533 || sym->attr.flavor == FL_DERIVED || !sym->binding_label)
12536 gsym = gfc_find_case_gsymbol (gfc_gsym_root, sym->binding_label);
12538 if (sym->module)
12539 module = sym->module;
12540 else if (sym->ns && sym->ns->proc_name
12541 && sym->ns->proc_name->attr.flavor == FL_MODULE)
12542 module = sym->ns->proc_name->name;
12543 else if (sym->ns && sym->ns->parent
12544 && sym->ns && sym->ns->parent->proc_name
12545 && sym->ns->parent->proc_name->attr.flavor == FL_MODULE)
12546 module = sym->ns->parent->proc_name->name;
12555 gsym = gfc_get_gsymbol (sym->binding_label, true);
12556 gsym->where = sym->declared_at;
12557 gsym->sym_name = sym->name;
12558 gsym->binding_label = sym->binding_label;
12559 gsym->ns = sym->ns;
12561 if (sym->attr.function)
12563 else if (sym->attr.subroutine)
12566 gsym->defined = sym->attr.if_source != IFSRC_IFBODY;
12570 if (sym->attr.flavor == FL_VARIABLE && gsym->type != GSYM_UNKNOWN)
12573 "identifier as entity at %L", sym->name,
12574 sym->binding_label, &sym->declared_at, &gsym->where);
12576 sym->binding_label = NULL;
12580 if (sym->attr.flavor == FL_VARIABLE && module
12582 || strcmp (sym->name, gsym->sym_name) != 0))
12588 sym->name, module, sym->binding_label,
12589 &sym->declared_at, &gsym->where, gsym->mod_name);
12590 sym->binding_label = NULL;
12594 if ((sym->attr.function || sym->attr.subroutine)
12596 || (gsym->defined && sym->attr.if_source != IFSRC_IFBODY))
12597 && (sym != gsym->ns->proc_name && sym->attr.entry == 0)
12599 || strcmp (gsym->sym_name, sym->name) != 0
12606 "global identifier as entity at %L", sym->name,
12607 sym->binding_label, &sym->declared_at, &gsym->where);
12608 sym->binding_label = NULL;
12704 is_non_constant_shape_array (gfc_symbol *sym)
12711 if (sym->as != NULL)
12716 for (i = 0; i < sym->as->rank + sym->as->corank; i++)
12721 e = sym->as->lower[i];
12725 e = sym->as->upper[i];
12737 build_init_assign (gfc_symbol *sym, gfc_expr *init)
12741 gfc_namespace *ns = sym->ns;
12745 if (sym->attr.function && sym == sym->result
12746 && sym->name != sym->ns->proc_name->name)
12750 if (strcmp (ns->proc_name->name, sym->name) == 0)
12761 lval = gfc_lval_expr_from_sym (sym);
12769 init_st->loc = sym->declared_at;
12778 can_generate_init (gfc_symbol *sym)
12781 if (!sym)
12783 a = &sym->attr;
12790 || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)
12791 && (CLASS_DATA (sym)->attr.class_pointer
12792 || CLASS_DATA (sym)->attr.proc_pointer))
12796 || sym->module
12799 || sym->assoc
12802 || sym->ns->proc_name->attr.if_source == IFSRC_IFBODY))
12803 || (a->function && sym != sym->result)
12811 apply_default_init (gfc_symbol *sym)
12815 if (sym->attr.flavor != FL_VARIABLE && !sym->attr.function)
12818 if (sym->ts.type == BT_DERIVED && sym->ts.u.derived)
12819 init = gfc_generate_initializer (&sym->ts, can_generate_init (sym));
12821 if (init == NULL && sym->ts.type != BT_CLASS)
12824 build_init_assign (sym, init);
12825 sym->attr.referenced = 1;
12833 build_default_init_expr (gfc_symbol *sym)
12836 if (sym->attr.allocatable
12837 || sym->attr.external
12838 || sym->attr.dummy
12839 || sym->attr.pointer
12840 || sym->attr.in_equivalence
12841 || sym->attr.in_common
12842 || sym->attr.data
12843 || sym->module
12844 || sym->attr.cray_pointee
12845 || sym->attr.cray_pointer
12846 || sym->assoc)
12850 return gfc_build_default_init_expr (&sym->ts, &sym->declared_at);
12855 apply_default_init_local (gfc_symbol *sym)
12860 if ((sym->attr.flavor != FL_VARIABLE && !sym->attr.function)
12861 || (sym->attr.function && sym->result != sym))
12866 init = build_default_init_expr (sym);
12874 if (!sym->attr.automatic
12875 && (sym->attr.save || sym->ns->save_all
12876 || (flag_max_stack_var_size == 0 && !sym->attr.result
12877 && (sym->ns->proc_name && !sym->ns->proc_name->attr.recursive)
12878 && (!sym->attr.dimension || !is_non_constant_shape_array (sym)))))
12881 gcc_assert (sym->value == NULL);
12882 sym->value = init;
12886 build_init_assign (sym, init);
12893 resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
12897 if (sym->ts.type == BT_CLASS && sym->attr.class_ok
12898 && sym->ts.u.derived && CLASS_DATA (sym))
12899 as = CLASS_DATA (sym)->as;
12901 as = sym->as;
12908 if (sym->ts.type == BT_CLASS && sym->attr.class_ok
12909 && sym->ts.u.derived && CLASS_DATA (sym))
12911 pointer = CLASS_DATA (sym)->attr.class_pointer;
12912 allocatable = CLASS_DATA (sym)->attr.allocatable;
12913 dimension = CLASS_DATA (sym)->attr.dimension;
12917 pointer = sym->attr.pointer && !sym->attr.select_type_temporary;
12918 allocatable = sym->attr.allocatable;
12919 dimension = sym->attr.dimension;
12927 && !sym->attr.select_rank_temporary)
12930 "shape or assumed rank", sym->name, &sym->declared_at);
12935 sym->name, &sym->declared_at))
12942 "assumed rank", sym->name, &sym->declared_at);
12943 sym->error = 1;
12949 if (!mp_flag && !sym->attr.allocatable && !sym->attr.pointer
12950 && sym->ts.type != BT_CLASS && !sym->assoc)
12953 sym->name, &sym->declared_at);
12959 if (sym->ts.type == BT_CLASS && !(sym->result && sym->result != sym))
12962 if (sym->attr.class_ok
12963 && sym->ts.u.derived
12964 && !sym->attr.select_type_temporary
12965 && !UNLIMITED_POLY (sym)
12966 && !gfc_type_is_extensible (CLASS_DATA (sym)->ts.u.derived))
12969 CLASS_DATA (sym)->ts.u.derived->name, sym->name,
12970 &sym->declared_at);
12978 if (!sym->attr.class_ok && !sym->attr.use_assoc && !sym->assoc)
12981 "or pointer", sym->name, &sym->declared_at);
12994 resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
12996 gcc_assert (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS);
13002 if (sym->ts.u.derived
13003 && sym->ns != sym->ts.u.derived->ns
13004 && !sym->ts.u.derived->attr.use_assoc
13005 && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY)
13008 gfc_find_symbol (sym->ts.u.derived->name, sym->ns, 0, &s);
13016 sym->ts.u.derived->name, &sym->declared_at,
13030 if (!(sym->value || no_init_flag) && sym->ns->proc_name
13031 && sym->ns->proc_name->attr.flavor == FL_MODULE
13032 && !(sym->ns->save_all && !sym->attr.automatic) && !sym->attr.save
13033 && !sym->attr.pointer && !sym->attr.allocatable
13034 && gfc_has_default_initializer (sym->ts.u.derived)
13037 "initialization", sym->name, &sym->declared_at))
13041 if (!(sym->value || sym->attr.pointer || sym->attr.allocatable)
13043 || (sym->attr.intent == INTENT_OUT
13044 && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY)))
13045 sym->value = gfc_generate_initializer (&sym->ts, can_generate_init (sym));
13056 deferred_requirements (gfc_symbol *sym)
13058 if (sym->ts.deferred
13059 && !(sym->attr.pointer
13060 || sym->attr.allocatable
13061 || sym->attr.associate_var
13062 || sym->attr.omp_udr_artificial_var))
13065 if (sym->result && sym->name != sym->result->name)
13070 sym->name, &sym->declared_at);
13080 resolve_fl_variable (gfc_symbol *sym, int mp_flag)
13085 if (!resolve_fl_var_and_proc (sym, mp_flag))
13094 if (sym->ns->proc_name
13095 && (sym->ns->proc_name->attr.flavor == FL_MODULE
13096 || sym->ns->proc_name->attr.is_main_program)
13097 && !sym->attr.use_assoc
13098 && !sym->attr.allocatable
13099 && !sym->attr.pointer
13100 && is_non_constant_shape_array (sym))
13105 "have constant shape", sym->name, &sym->declared_at);
13111 if (!deferred_requirements (sym))
13114 if (sym->ts.type == BT_CHARACTER && !sym->attr.associate_var)
13120 if (sym->ts.u.cl)
13121 e = sym->ts.u.cl->length;
13125 if (e == NULL && !sym->attr.dummy && !sym->attr.result
13126 && !sym->ts.deferred && !sym->attr.select_type_temporary
13127 && !sym->attr.omp_udr_artificial_var)
13130 "dummy argument or a PARAMETER", &sym->declared_at);
13135 if (e && sym->attr.save == SAVE_EXPLICIT && !gfc_is_constant_expr (e))
13137 gfc_error (auto_save_msg, sym->name, &sym->declared_at);
13144 && e->symtree->n.sym->attr.flavor == FL_PARAMETER))
13146 if (!sym->attr.use_assoc && sym->ns->proc_name
13147 && (sym->ns->proc_name->attr.flavor == FL_MODULE
13148 || sym->ns->proc_name->attr.is_main_program))
13151 "in this context", sym->name, &sym->declared_at);
13155 if (sym->attr.in_common)
13158 "character length", sym->name, &sym->declared_at);
13165 if (sym->value == NULL && sym->attr.referenced)
13166 apply_default_init_local (sym); /* Try to apply a default initialization. */
13170 if (sym->attr.allocatable || sym->attr.external || sym->attr.dummy
13171 || sym->attr.intrinsic || sym->attr.result)
13173 else if ((sym->attr.dimension || sym->attr.codimension) && !sym->attr.pointer
13174 && is_non_constant_shape_array (sym))
13180 if (sym->as && sym->attr.codimension)
13182 int corank = sym->as->corank;
13183 sym->as->corank = 0;
13184 no_init_flag = automatic_flag = is_non_constant_shape_array (sym);
13185 sym->as->corank = corank;
13187 if (automatic_flag && sym->attr.save == SAVE_EXPLICIT)
13189 gfc_error (auto_save_msg, sym->name, &sym->declared_at);
13196 if (sym->value)
13197 gfc_simplify_expr (sym->value, 1);
13200 if (!sym->mark && sym->value)
13202 if (sym->attr.allocatable || (sym->ts.type == BT_CLASS
13203 && CLASS_DATA (sym)->attr.allocatable))
13205 sym->name, &sym->declared_at);
13206 else if (sym->attr.external)
13208 sym->name, &sym->declared_at);
13209 else if (sym->attr.dummy)
13211 sym->name, &sym->declared_at);
13212 else if (sym->attr.intrinsic)
13214 sym->name, &sym->declared_at);
13215 else if (sym->attr.result)
13217 sym->name, &sym->declared_at);
13220 sym->name, &sym->declared_at);
13228 if (sym->ts.type == BT_DERIVED || sym->ts.type == BT_CLASS)
13230 bool res = resolve_fl_variable_derived (sym, no_init_flag);
13246 compare_fsyms (gfc_symbol *sym)
13250 if (sym == NULL || new_formal == NULL)
13253 fsym = new_formal->sym;
13255 if (sym == fsym)
13258 if (strcmp (sym->name, fsym->name) == 0)
13260 if (!gfc_check_dummy_characteristics (fsym, sym, true, errmsg, 200))
13269 resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
13274 if (sym->attr.function
13275 && !resolve_fl_var_and_proc (sym, mp_flag))
13279 if (!deferred_requirements (sym))
13282 if (sym->ts.type == BT_CHARACTER)
13284 gfc_charlen *cl = sym->ts.u.cl;
13291 && sym->attr.proc == PROC_ST_FUNCTION)
13294 "have constant length", sym->name, &sym->declared_at);
13303 if (!(sym->ns->parent && sym->ns->parent->proc_name
13304 && sym->ns->parent->proc_name->attr.flavor == FL_MODULE)
13305 && gfc_check_symbol_access (sym))
13309 for (arg = gfc_sym_get_dummy_args (sym); arg; arg = arg->next)
13311 if (arg->sym
13312 && arg->sym->ts.type == BT_DERIVED
13313 && arg->sym->ts.u.derived
13314 && !arg->sym->ts.u.derived->attr.use_assoc
13315 && !gfc_check_symbol_access (arg->sym->ts.u.derived)
13319 arg->sym->name, sym->name,
13320 &sym->declared_at))
13323 arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC;
13330 for (iface = sym->generic; iface; iface = iface->next)
13332 for (arg = gfc_sym_get_dummy_args (iface->sym); arg; arg = arg->next)
13334 if (arg->sym
13335 && arg->sym->ts.type == BT_DERIVED
13336 && !arg->sym->ts.u.derived->attr.use_assoc
13337 && !gfc_check_symbol_access (arg->sym->ts.u.derived)
13341 "is PRIVATE", iface->sym->name,
13342 sym->name, &iface->sym->declared_at,
13343 gfc_typename(&arg->sym->ts)))
13346 arg->sym->ts.u.derived->attr.access = ACCESS_PUBLIC;
13353 if (sym->attr.function && sym->value && sym->attr.proc != PROC_ST_FUNCTION
13354 && !sym->attr.proc_pointer)
13357 sym->name, &sym->declared_at);
13360 sym->value->error = 1;
13366 if (sym->attr.external && sym->value && !sym->attr.proc_pointer)
13369 sym->name, &sym->declared_at);
13374 if (sym->attr.elemental && sym->attr.function
13375 && (sym->as || (sym->ts.type == BT_CLASS && sym->attr.class_ok
13376 && CLASS_DATA (sym)->as)))
13379 "result", sym->name, &sym->declared_at);
13381 sym->attr.elemental = 0;
13385 if (sym->attr.proc == PROC_ST_FUNCTION
13386 && (sym->attr.allocatable || sym->attr.pointer))
13389 "allocatable attribute", sym->name, &sym->declared_at);
13399 if (sym->attr.function
13400 && sym->ts.type == BT_CHARACTER && !sym->ts.deferred
13401 && sym->ts.u.cl && sym->ts.u.cl->length == NULL)
13403 if ((sym->as && sym->as->rank) || (sym->attr.pointer)
13404 || (sym->attr.recursive) || (sym->attr.pure))
13406 if (sym->as && sym->as->rank)
13408 "array-valued", sym->name, &sym->declared_at);
13410 if (sym->attr.pointer)
13412 "pointer-valued", sym->name, &sym->declared_at);
13414 if (sym->attr.pure)
13416 "pure", sym->name, &sym->declared_at);
13418 if (sym->attr.recursive)
13420 "recursive", sym->name, &sym->declared_at);
13429 if (!sym->attr.contained && !sym->ts.deferred
13430 && (sym->name[0] != '_' || sym->name[1] != '_'))
13433 sym->name, &sym->declared_at);
13437 if (sym->attr.elemental)
13439 if (sym->attr.proc_pointer)
13441 const char* name = (sym->attr.result ? sym->ns->proc_name->name
13442 : sym->name);
13444 name, &sym->declared_at);
13447 if (sym->attr.dummy)
13450 sym->name, &sym->declared_at);
13458 if (sym->result)
13459 allocatable_or_pointer = sym->result->ts.type == BT_CLASS
13460 && CLASS_DATA (sym->result) ?
13461 (CLASS_DATA (sym->result)->attr.allocatable
13462 || CLASS_DATA (sym->result)->attr.pointer) :
13463 (sym->result->attr.allocatable
13464 || sym->result->attr.pointer);
13466 if (sym->attr.elemental && sym->result
13471 "attribute", sym->result->name,
13472 &sym->result->declared_at, sym->name);
13476 if (sym->attr.is_bind_c && sym->attr.is_c_interop != 1)
13481 if (!verify_bind_c_sym (sym, &(sym->ts), sym->attr.in_common,
13482 sym->common_block))
13486 sym->attr.is_bind_c = 0;
13487 sym->attr.is_c_interop = 0;
13488 sym->ts.is_c_interop = 0;
13493 sym->attr.is_c_interop = 1;
13494 sym->ts.is_c_interop = 1;
13497 curr_arg = gfc_sym_get_dummy_args (sym);
13501 if (curr_arg->sym && curr_arg->sym->attr.implicit_type == 0)
13502 if (!gfc_verify_c_interop_param (curr_arg->sym))
13516 sym->attr.is_c_interop = 0;
13517 sym->ts.is_c_interop = 0;
13518 sym->attr.is_bind_c = 0;
13522 if (!sym->attr.proc_pointer)
13524 if (sym->attr.save == SAVE_EXPLICIT)
13527 "in %qs at %L", sym->name, &sym->declared_at);
13530 if (sym->attr.intent)
13533 "in %qs at %L", sym->name, &sym->declared_at);
13536 if (sym->attr.subroutine && sym->attr.result)
13539 "in %qs at %L", sym->ns->proc_name->name, &sym->declared_at);
13542 if (sym->attr.external && sym->attr.function && !sym->attr.module_procedure
13543 && ((sym->attr.if_source == IFSRC_DECL && !sym->attr.procedure)
13544 || sym->attr.contained))
13547 "in %qs at %L", sym->name, &sym->declared_at);
13550 if (strcmp ("ppr@", sym->name) == 0)
13554 sym->ns->proc_name->name, &sym->declared_at);
13561 if (sym->attr.if_source != IFSRC_DECL)
13562 sym->attr.array_outer_dependency = 1;
13568 if (sym->attr.module_procedure
13569 && sym->attr.if_source == IFSRC_DECL)
13575 strcpy (name, sym->ns->proc_name->name);
13579 iface = sym->tlink;
13580 sym->tlink = NULL;
13584 if (iface && sym->result
13587 sym->result->ts.u.cl = iface->ts.u.cl;
13593 if (sym->attr.elemental != iface->attr.elemental)
13597 &sym->declared_at, module_name);
13601 if (sym->attr.pure != iface->attr.pure)
13605 &sym->declared_at, module_name);
13609 if (sym->attr.recursive != iface->attr.recursive)
13613 &sym->declared_at, module_name);
13618 if (!gfc_check_result_characteristics (sym, iface, errmsg, 200))
13623 errmsg, module_name, &sym->declared_at,
13630 if (sym->formal && sym->formal_ns)
13632 for (arg = sym->formal; arg && arg->sym; arg = arg->next)
13635 gfc_traverse_ns (sym->formal_ns, compare_fsyms);
13642 if (sym->attr.is_bind_c && sym->attr.if_source == IFSRC_UNKNOWN)
13645 sym->name, &sym->declared_at);
13704 if (list->proc_tree->n.sym->formal->sym->as == NULL
13705 || list->proc_tree->n.sym->formal->sym->as->rank == 0)
13727 arg = dummy_args->sym;
13787 gfc_symbol* i_arg = dummy_args->sym;
13834 gfc_set_sym_referenced (c->initializer->symtree->n.sym);
13858 sym1 = t1->specific->u.specific->n.sym;
13859 sym2 = t2->specific->u.specific->n.sym;
13881 dummy_args = gfc_sym_get_dummy_args (t1->specific->u.specific->n.sym);
13883 pass1 = dummy_args->sym->name;
13893 dummy_args = gfc_sym_get_dummy_args (t2->specific->u.specific->n.sym);
13895 pass2 = dummy_args->sym->name;
14012 p->subroutine = first_target->n.sym->attr.subroutine;
14013 p->function = first_target->n.sym->attr.function;
14053 target_proc = target->specific->u.specific->n.sym;
14117 if (intr->sym == target_proc
14126 intr->sym = target_proc;
14146 static bool check_uop_procedure (gfc_symbol* sym, locus where);
14232 proc = stree->n.tb->u.specific->n.sym;
14304 if (!strcmp (i->sym->name, stree->n.tb->pass_arg))
14306 me_arg = i->sym;
14332 me_arg = dummy_args->sym;
14588 sym)
14599 if (sym->attr.vtype && sym->attr.use_assoc
14600 && sym->ns->proc_name == NULL)
14604 if ((!sym->attr.is_class || c != sym->components)
14658 if (sym->attr.is_bind_c && c->ts.type == BT_CHARACTER
14672 if (!sym->attr.vtype && !check_proc_interface (ifc, &c->loc))
14716 gfc_charlen *cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
14736 && !sym->attr.vtype)
14751 if (!strcmp (i->sym->name, c->tb->pass_arg))
14753 me_arg = i->sym;
14781 me_arg = c->ts.interface->formal->sym;
14787 || (me_arg->ts.type == BT_DERIVED && me_arg->ts.u.derived != sym)
14789 && CLASS_DATA (me_arg)->ts.u.derived != sym))
14793 me_arg->name, &c->loc, sym->name);
14826 if (gfc_type_is_extensible (sym) && me_arg->ts.type != BT_CLASS)
14836 if (((sym->attr.is_class
14837 && (!sym->components->ts.u.derived->attr.extension
14838 || c != sym->components->ts.u.derived->components))
14839 || (!sym->attr.is_class
14840 && (!sym->attr.extension || c != sym->components)))
14841 && !sym->attr.vtype
14845 super_type = gfc_get_derived_super_type (sym);
14850 && ((sym->attr.is_class
14851 && c == sym->components->ts.u.derived->components)
14852 || (!sym->attr.is_class && c == sym->components))
14858 if (super_type && !sym->attr.is_class
14863 c->name, sym->name, &c->loc);
14900 c->name, sym->name, &c->loc);
14908 && !sym->attr.is_class)
14913 strlen = gfc_find_component (sym, name, true, true, NULL);
14916 if (!gfc_add_component (sym, name, &strlen))
14926 && sym->component_access != ACCESS_PRIVATE
14927 && gfc_check_symbol_access (sym)
14928 && !is_sym_host_assoc (c->ts.u.derived, sym->ns)
14934 sym->name, &sym->declared_at))
14937 if ((sym->attr.sequence || sym->attr.is_bind_c) && c->ts.type == BT_CLASS)
14940 "type %s", c->name, &c->loc, sym->name);
14944 if (sym->attr.sequence)
14950 c->ts.u.derived->name, &sym->declared_at);
14966 && c->ts.u.derived == sym && c->attr.allocatable == 1)
14976 && sym != c->ts.u.derived)
14988 if (c->initializer && !sym->attr.vtype
14990 && !gfc_check_assign_symbol (sym, c, c->initializer))
15021 resolve_fl_struct (gfc_symbol *sym)
15028 if (sym->attr.flavor == FL_UNION)
15030 for (c = sym->components; c; c = c->next)
15045 for (c = sym->components; c; c = c->next)
15046 if (!resolve_component (c, sym))
15052 if (sym->components)
15053 add_dt_to_dt_list (sym);
15064 resolve_fl_derived0 (gfc_symbol *sym)
15071 if (sym->attr.unlimited_polymorphic)
15074 super_type = gfc_get_derived_super_type (sym);
15077 if (super_type && sym->attr.coarray_comp && !super_type->attr.coarray_comp)
15080 "parent type %qs shall also have one", sym->name,
15081 &sym->declared_at, super_type->name);
15090 if (sym->attr.abstract && !gfc_type_is_extensible (sym))
15093 sym->name, &sym->declared_at);
15097 c = (sym->attr.is_class) ? sym->components->ts.u.derived->components
15098 : sym->components;
15102 if (!resolve_component (c, sym))
15110 && !sym->attr.is_class && !sym->attr.vtype)
15112 for (c = sym->components; c; c = c->next)
15119 token = gfc_find_component (sym, name, true, true, NULL);
15122 if (!gfc_add_component (sym, name, &token))
15133 check_defined_assignments (sym);
15135 if (!sym->attr.defined_assign_comp && super_type)
15136 sym->attr.defined_assign_comp
15141 if (super_type && super_type->attr.abstract && !sym->attr.abstract
15142 && !sym->attr.is_class
15143 && !ensure_not_abstract (sym, super_type))
15147 if (sym->attr.pdt_template)
15149 for (f = sym->formal; f; f = f->next)
15151 if (!f->sym)
15153 c = gfc_find_component (sym, f->sym->name, true, true, NULL);
15157 "corresponding to parameter %qs at %L", sym->name,
15158 f->sym->name, &sym->declared_at);
15165 add_dt_to_dt_list (sym);
15177 resolve_fl_derived (gfc_symbol *sym)
15181 if (sym->attr.unlimited_polymorphic)
15184 if (!sym->attr.is_class)
15185 gfc_find_symbol (sym->name, sym->ns, 0, &gen_dt);
15187 && (!gen_dt->generic->sym->attr.use_assoc
15188 || gen_dt->generic->sym->module != gen_dt->generic->next->sym->module)
15191 "type at %L", sym->name,
15192 gen_dt->generic->sym == sym
15193 ? gen_dt->generic->next->sym->name
15194 : gen_dt->generic->sym->name,
15195 gen_dt->generic->sym == sym
15196 ? &gen_dt->generic->next->sym->declared_at
15197 : &gen_dt->generic->sym->declared_at,
15198 &sym->declared_at))
15201 if (sym->components == NULL && !sym->attr.zero_comp && !sym->attr.use_assoc)
15204 sym->name, &sym->declared_at);
15209 if (!gfc_resolve_finalizers (sym, NULL))
15212 if (sym->attr.is_class && sym->ts.u.derived == NULL)
15215 gfc_component *data = gfc_find_component (sym, "_data", true, true, NULL);
15216 gfc_component *vptr = gfc_find_component (sym, "_vptr", true, true, NULL);
15221 add_dt_to_dt_list (sym);
15234 if (!resolve_fl_derived0 (sym))
15238 if (!resolve_typebound_procedures (sym))
15246 && sym->ns->proc_name
15247 && sym->ns->proc_name->attr.flavor == FL_MODULE
15248 && sym->attr.access != ACCESS_PRIVATE
15249 && !(sym->attr.use_assoc || sym->attr.vtype || sym->attr.pdt_template))
15251 gfc_symbol *vtab = gfc_find_derived_vtab (sym);
15260 resolve_fl_namelist (gfc_symbol *sym)
15265 for (nl = sym->namelist; nl; nl = nl->next)
15269 if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SIZE)
15272 "allowed", nl->sym->name, sym->name, &sym->declared_at);
15276 if (nl->sym->as && nl->sym->as->type == AS_ASSUMED_SHAPE
15279 nl->sym->name, sym->name, &sym->declared_at))
15282 if (is_non_constant_shape_array (nl->sym)
15285 nl->sym->name, sym->name, &sym->declared_at))
15288 if (nl->sym->ts.type == BT_CHARACTER
15289 && (nl->sym->ts.u.cl->length == NULL
15290 || !gfc_is_constant_expr (nl->sym->ts.u.cl->length))
15293 "namelist %qs at %L", nl->sym->name,
15294 sym->name, &sym->declared_at))
15300 if (gfc_check_symbol_access (sym))
15302 for (nl = sym->namelist; nl; nl = nl->next)
15304 if (!nl->sym->attr.use_assoc
15305 && !is_sym_host_assoc (nl->sym, sym->ns)
15306 && !gfc_check_symbol_access (nl->sym))
15310 nl->sym->name, sym->name, &sym->declared_at);
15314 if (nl->sym->ts.type == BT_DERIVED
15315 && (nl->sym->ts.u.derived->attr.alloc_comp
15316 || nl->sym->ts.u.derived->attr.pointer_comp))
15320 "or POINTER components", nl->sym->name,
15321 sym->name, &sym->declared_at))
15327 if (nl->sym->ts.type == BT_DERIVED
15328 && derived_inaccessible (nl->sym->ts.u.derived))
15332 nl->sym->name, sym->name, &sym->declared_at);
15337 if (nl->sym->ts.type == BT_DERIVED
15338 && !is_sym_host_assoc (nl->sym->ts.u.derived, sym->ns)
15339 && nl->sym->ts.u.derived->attr.private_comp)
15343 nl->sym->name, sym->name, &sym->declared_at);
15352 for (nl = sym->namelist; nl; nl = nl->next)
15354 if (nl->sym->ts.kind != 0 && nl->sym->attr.flavor == FL_VARIABLE)
15357 if (nl->sym->attr.function && nl->sym == nl->sym->result)
15358 if ((nl->sym == sym->ns->proc_name)
15360 (sym->ns->parent && nl->sym == sym->ns->parent->proc_name))
15364 if (nl->sym->name)
15365 gfc_find_symbol (nl->sym->name, sym->ns, 1, &nlsym);
15370 &sym->declared_at);
15380 resolve_fl_parameter (gfc_symbol *sym)
15383 if (sym->as != NULL
15384 && (sym->as->type == AS_DEFERRED
15385 || is_non_constant_shape_array (sym)))
15388 "or of deferred shape", sym->name, &sym->declared_at);
15393 if (!deferred_requirements (sym))
15399 if (sym->attr.implicit_type
15400 && !gfc_compare_types (&sym->ts, gfc_get_default_type (sym->name,
15401 sym->ns)))
15404 "later IMPLICIT type", sym->name, &sym->declared_at);
15411 if (sym->ts.type == BT_DERIVED
15412 && !gfc_compare_types (&sym->ts, &sym->value->ts))
15415 &sym->value->where);
15420 if (sym->ts.type == BT_CLASS)
15423 sym->name, &sym->declared_at);
15434 resolve_pdt (gfc_symbol* sym)
15443 if (sym->ts.type == BT_DERIVED)
15445 derived = sym->ts.u.derived;
15446 attr = &(sym->attr);
15448 else if (sym->ts.type == BT_CLASS)
15450 derived = CLASS_DATA (sym)->ts.u.derived;
15451 attr = &(CLASS_DATA (sym)->attr);
15458 for (param = sym->param_list; param; param = param->next)
15475 "nor a pointer", sym->name, &sym->declared_at,
15481 && (sym->ns->proc_name->attr.is_main_program
15482 || sym->ns->proc_name->attr.flavor == FL_MODULE
15483 || sym->attr.save != SAVE_NONE))
15487 sym->name, &sym->declared_at);
15489 if (assumed_len_exprs && !(sym->attr.dummy
15490 || sym->attr.select_type_temporary || sym->attr.associate_var))
15493 sym->name, &sym->declared_at);
15502 resolve_symbol (gfc_symbol *sym)
15513 if (sym->resolve_symbol_called >= 1)
15515 sym->resolve_symbol_called = 1;
15520 gcc_assert (sym->ts.type != BT_UNION);
15524 if (flag_coarray == GFC_FCOARRAY_LIB && sym->ts.type == BT_CLASS
15525 && sym->ts.u.derived && CLASS_DATA (sym)
15526 && CLASS_DATA (sym)->attr.codimension
15527 && CLASS_DATA (sym)->ts.u.derived
15528 && (CLASS_DATA (sym)->ts.u.derived->attr.alloc_comp
15529 || CLASS_DATA (sym)->ts.u.derived->attr.pointer_comp))
15532 "type coarrays at %L are unsupported", &sym->declared_at);
15536 if (sym->attr.artificial)
15539 if (sym->attr.unlimited_polymorphic)
15542 if (sym->attr.flavor == FL_UNKNOWN
15543 || (sym->attr.flavor == FL_PROCEDURE && !sym->attr.intrinsic
15544 && !sym->attr.generic && !sym->attr.external
15545 && sym->attr.if_source == IFSRC_UNKNOWN
15546 && sym->ts.type == BT_UNKNOWN))
15554 symtree = gfc_find_symtree (ns->sym_root, sym->name);
15555 if (symtree && (symtree->n.sym->generic ||
15556 (symtree->n.sym->attr.flavor == FL_PROCEDURE
15557 && sym->ns->construct_entities)))
15560 sym->name);
15561 if (this_symtree->n.sym == sym)
15563 symtree->n.sym->refs++;
15564 gfc_release_symbol (sym);
15565 this_symtree->n.sym = symtree->n.sym;
15573 if (sym->attr.flavor == FL_UNKNOWN && sym->attr.external == 0
15574 && sym->attr.intrinsic == 0)
15575 sym->attr.flavor = FL_VARIABLE;
15576 else if (sym->attr.flavor == FL_UNKNOWN)
15578 sym->attr.flavor = FL_PROCEDURE;
15579 if (sym->attr.dimension)
15580 sym->attr.function = 1;
15584 if (sym->attr.external && sym->ts.type != BT_UNKNOWN && !sym->attr.function)
15585 gfc_add_function (&sym->attr, sym->name, &sym->declared_at);
15587 if (sym->attr.procedure && sym->attr.if_source != IFSRC_DECL
15588 && !resolve_procedure_interface (sym))
15591 if (sym->attr.is_protected && !sym->attr.proc_pointer
15592 && (sym->attr.procedure || sym->attr.external))
15594 if (sym->attr.external)
15596 "at %L", &sym->declared_at);
15599 "at %L", &sym->declared_at);
15604 if (sym->attr.flavor == FL_DERIVED && !resolve_fl_derived (sym))
15607 else if ((sym->attr.flavor == FL_STRUCT || sym->attr.flavor == FL_UNION)
15608 && !resolve_fl_struct (sym))
15616 mp_flag = (sym->result != NULL && sym->result != sym);
15621 if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic
15622 && !gfc_resolve_intrinsic (sym, &sym->declared_at))
15626 if (sym->assoc)
15627 resolve_assoc_var (sym, true);
15630 if (sym->ts.type == BT_UNKNOWN)
15632 if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER)
15634 gfc_set_default_type (sym, 1, NULL);
15637 if (sym->attr.flavor == FL_PROCEDURE && sym->attr.external
15638 && !sym->attr.function && !sym->attr.subroutine
15639 && gfc_get_default_type (sym->name, sym->ns)->type == BT_UNKNOWN)
15640 gfc_add_subroutine (&sym->attr, sym->name, &sym->declared_at);
15642 if (sym->attr.flavor == FL_PROCEDURE && sym->attr.function)
15648 if (!sym->attr.mixed_entry_master)
15649 gfc_set_default_type (sym, sym->attr.external, NULL);
15654 resolve_symbol (sym->result);
15656 if (!sym->result->attr.proc_pointer)
15658 sym->ts = sym->result->ts;
15659 sym->as = gfc_copy_array_spec (sym->result->as);
15660 sym->attr.dimension = sym->result->attr.dimension;
15661 sym->attr.pointer = sym->result->attr.pointer;
15662 sym->attr.allocatable = sym->result->attr.allocatable;
15663 sym->attr.contiguous = sym->result->attr.contiguous;
15668 else if (mp_flag && sym->attr.flavor == FL_PROCEDURE && sym->attr.function)
15675 gfc_resolve_array_spec (sym->result->as, false);
15680 if (sym->ts.type == BT_CLASS && sym->attr.class_ok && sym->ts.u.derived)
15682 as = CLASS_DATA (sym)->as;
15683 class_attr = CLASS_DATA (sym)->attr;
15688 class_attr = sym->attr;
15689 as = sym->as;
15693 if (sym->attr.contiguous
15700 sym->name, &sym->declared_at);
15729 && !sym->attr.dummy && !sym->attr.select_type_temporary)
15733 &sym->declared_at);
15736 &sym->declared_at);
15740 if (as->type == AS_ASSUMED_RANK && !sym->attr.dummy
15741 && !sym->attr.select_type_temporary
15746 &sym->declared_at);
15750 && (sym->attr.codimension || sym->attr.value))
15753 "CODIMENSION attribute", &sym->declared_at);
15762 if (!sym->attr.dummy
15763 && (sym->attr.optional || sym->attr.intent != INTENT_UNKNOWN))
15765 gfc_error ("Symbol at %L is not a DUMMY variable", &sym->declared_at);
15769 if (sym->attr.value && !sym->attr.dummy)
15772 "it is not a dummy argument", sym->name, &sym->declared_at);
15776 if (sym->attr.value && sym->ts.type == BT_CHARACTER)
15778 gfc_charlen *cl = sym->ts.u.cl;
15783 sym->name, &sym->declared_at);
15787 if (sym->ts.is_c_interop
15792 sym->name, &sym->declared_at);
15797 if (sym->ts.type == BT_DERIVED && !sym->attr.is_iso_c
15798 && sym->ts.u.derived->attr.generic)
15800 sym->ts.u.derived = gfc_find_dt_in_generic (sym->ts.u.derived);
15801 if (!sym->ts.u.derived)
15804 "which has not been defined", sym->name,
15805 &sym->declared_at, sym->ts.u.derived->name);
15806 sym->ts.type = BT_UNKNOWN;
15813 if (sym->attr.ext_attr & (1 << EXT_ATTR_NO_ARG_CHECK))
15815 if (!sym->attr.dummy)
15818 "a dummy argument", sym->name, &sym->declared_at);
15822 if (sym->ts.type != BT_ASSUMED && sym->ts.type != BT_INTEGER
15823 && sym->ts.type != BT_REAL && sym->ts.type != BT_LOGICAL
15824 && sym->ts.type != BT_COMPLEX)
15828 sym->name, &sym->declared_at);
15832 if (sym->attr.allocatable || sym->attr.codimension
15833 || sym->attr.pointer || sym->attr.value)
15837 "attribute", sym->name, &sym->declared_at);
15841 if (sym->attr.intent == INTENT_OUT)
15845 sym->name, &sym->declared_at);
15848 if (sym->attr.dimension && sym->as->type != AS_ASSUMED_SIZE)
15852 sym->name, &sym->declared_at);
15859 sym->ts.type = BT_ASSUMED;
15860 sym->as = gfc_get_array_spec ();
15861 sym->as->type = AS_ASSUMED_SIZE;
15862 sym->as->rank = 1;
15863 sym->as->lower[0] = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
15865 else if (sym->ts.type == BT_ASSUMED)
15868 if (!sym->attr.dummy)
15871 "for dummy variables", sym->name, &sym->declared_at);
15874 if (sym->attr.allocatable || sym->attr.codimension
15875 || sym->attr.pointer || sym->attr.value)
15879 sym->name, &sym->declared_at);
15882 if (sym->attr.intent == INTENT_OUT)
15886 sym->name, &sym->declared_at);
15889 if (sym->attr.dimension && sym->as->type == AS_EXPLICIT)
15892 "explicit-shape array", sym->name, &sym->declared_at);
15906 if (sym->attr.is_bind_c && sym->attr.use_assoc == 0
15907 && sym->attr.dummy == 0 && sym->attr.flavor != FL_PROCEDURE
15908 && sym->attr.flavor != FL_DERIVED)
15914 if (!(sym->ns->proc_name && sym->ns->proc_name->attr.flavor == FL_MODULE)
15915 && !sym->attr.in_common)
15919 "module level scope", sym->name, &(sym->declared_at));
15922 else if (sym->ts.type == BT_CHARACTER
15923 && (sym->ts.u.cl == NULL || sym->ts.u.cl->length == NULL
15924 || !gfc_is_constant_expr (sym->ts.u.cl->length)
15925 || mpz_cmp_si (sym->ts.u.cl->length->value.integer, 1) != 0))
15928 sym->name, &sym->declared_at);
15931 else if (sym->common_head != NULL && sym->attr.implicit_type == 0)
15933 t = verify_com_block_vars_c_interop (sym->common_head);
15935 else if (sym->attr.implicit_type == 0)
15939 if (sym->ts.type == BT_DERIVED &&
15940 sym->ts.u.derived->attr.is_c_interop != 1)
15946 if (sym->ts.u.derived->attr.is_bind_c != 1)
15947 verify_bind_c_derived_type (sym->ts.u.derived);
15955 t = verify_bind_c_sym (sym, &(sym->ts), sym->attr.in_common,
15956 sym->common_block);
15963 sym->attr.is_bind_c = 0;
15976 if (sym->ts.type == BT_DERIVED && !sym->attr.is_iso_c
15977 && sym->ts.u.derived->components == NULL
15978 && !sym->ts.u.derived->attr.zero_comp)
15981 "which has not been defined", sym->name,
15982 &sym->declared_at, sym->ts.u.derived->name);
15983 sym->ts.type = BT_UNKNOWN;
15990 if (sym->ts.type == BT_DERIVED
15991 && sym->ts.u.derived->attr.use_assoc
15992 && sym->ns->proc_name
15993 && sym->ns->proc_name->attr.flavor == FL_MODULE
15994 && !resolve_fl_derived (sym->ts.u.derived))
16001 if (sym->ts.type == BT_DERIVED
16002 && sym->ns->proc_name && sym->ns->proc_name->attr.flavor == FL_MODULE
16003 && !sym->ts.u.derived->attr.use_assoc
16004 && gfc_check_symbol_access (sym)
16005 && !gfc_check_symbol_access (sym->ts.u.derived)
16008 (sym->attr.flavor == FL_PARAMETER)
16010 sym->name, &sym->declared_at,
16011 sym->ts.u.derived->name))
16015 if (sym->ts.type == BT_DERIVED
16016 && ((sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
16017 && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_LOCK_TYPE)
16018 || sym->ts.u.derived->attr.lock_comp)
16019 && !sym->attr.codimension && !sym->ts.u.derived->attr.coarray_comp)
16022 "type LOCK_TYPE must be a coarray", sym->name,
16023 &sym->declared_at);
16028 if (sym->ts.type == BT_DERIVED
16029 && ((sym->ts.u.derived->from_intmod == INTMOD_ISO_FORTRAN_ENV
16030 && sym->ts.u.derived->intmod_sym_id == ISOFORTRAN_EVENT_TYPE)
16031 || sym->ts.u.derived->attr.event_comp)
16032 && !sym->attr.codimension && !sym->ts.u.derived->attr.coarray_comp)
16035 "type EVENT_TYPE must be a coarray", sym->name,
16036 &sym->declared_at);
16042 if (sym->ts.type == BT_DERIVED
16043 && sym->attr.dummy
16044 && sym->attr.intent == INTENT_OUT
16045 && sym->as
16046 && sym->as->type == AS_ASSUMED_SIZE)
16048 for (c = sym->ts.u.derived->components; c; c = c->next)
16054 sym->name, &sym->declared_at);
16061 if (sym->ts.type == BT_DERIVED && sym->attr.dummy
16062 && sym->attr.intent == INTENT_OUT && sym->attr.lock_comp)
16065 "INTENT(OUT)", sym->name, &sym->declared_at);
16070 if (sym->ts.type == BT_DERIVED && sym->attr.dummy
16071 && sym->attr.intent == INTENT_OUT && sym->attr.event_comp)
16074 "INTENT(OUT)", sym->name, &sym->declared_at);
16079 if ((((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
16080 || (sym->ts.type == BT_CLASS && sym->attr.class_ok
16081 && sym->ts.u.derived && CLASS_DATA (sym)
16082 && CLASS_DATA (sym)->attr.coarray_comp))
16084 && (sym->attr.result || sym->result == sym))
16087 "a coarray component", sym->name, &sym->declared_at);
16092 if (sym->attr.codimension && sym->ts.type == BT_DERIVED
16093 && sym->ts.u.derived->ts.is_iso_c)
16096 "shall not be a coarray", sym->name, &sym->declared_at);
16101 if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
16102 || (sym->ts.type == BT_CLASS && sym->attr.class_ok
16103 && sym->ts.u.derived && CLASS_DATA (sym)
16104 && CLASS_DATA (sym)->attr.coarray_comp))
16110 sym->name, &sym->declared_at);
16116 && !(class_attr.allocatable || sym->attr.dummy || sym->attr.save
16117 || sym->attr.select_type_temporary
16118 || sym->attr.associate_var
16119 || (sym->ns->save_all && !sym->attr.automatic)
16120 || sym->ns->proc_name->attr.flavor == FL_MODULE
16121 || sym->ns->proc_name->attr.is_main_program
16122 || sym->attr.function || sym->attr.result || sym->attr.use_assoc))
16125 "nor a dummy argument", sym->name, &sym->declared_at);
16129 else if (class_attr.codimension && !sym->attr.select_type_temporary
16133 "deferred shape", sym->name, &sym->declared_at);
16140 "deferred shape", sym->name, &sym->declared_at);
16145 if ((((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
16146 || (sym->ts.type == BT_CLASS && sym->attr.class_ok
16147 && sym->ts.u.derived && CLASS_DATA (sym)
16148 && CLASS_DATA (sym)->attr.coarray_comp))
16150 && sym->attr.dummy && sym->attr.intent == INTENT_OUT)
16154 sym->name, &sym->declared_at);
16158 if (class_attr.codimension && sym->attr.dummy
16159 && sym->ns->proc_name && sym->ns->proc_name->attr.is_bind_c)
16162 "procedure %qs", sym->name, &sym->declared_at,
16163 sym->ns->proc_name->name);
16167 if (sym->ts.type == BT_LOGICAL
16168 && ((sym->attr.function && sym->attr.is_bind_c && sym->result == sym)
16169 || ((sym->attr.dummy || sym->attr.result) && sym->ns->proc_name
16170 && sym->ns->proc_name->attr.is_bind_c)))
16174 if (gfc_logical_kinds[i].kind == sym->ts.kind)
16176 if (!gfc_logical_kinds[i].c_bool && sym->attr.dummy
16179 "%qs", sym->name, &sym->declared_at,
16180 sym->ns->proc_name->name))
16185 "BIND(C) procedure %qs", sym->name,
16186 &sym->declared_at,
16187 sym->attr.function ? sym->name
16188 : sym->ns->proc_name->name))
16192 switch (sym->attr.flavor)
16195 if (!resolve_fl_variable (sym, mp_flag))
16200 if (sym->formal && !sym->formal_ns)
16203 gfc_formal_arglist *formal = sym->formal;
16206 if (formal->sym && formal->sym->attr.flavor == FL_NAMELIST)
16210 formal->sym->name, &sym->declared_at);
16215 if (!resolve_fl_procedure (sym, mp_flag))
16220 if (!resolve_fl_namelist (sym))
16225 if (!resolve_fl_parameter (sym))
16236 check_constant = sym->attr.in_common && !sym->attr.pointer;
16241 if ((sym->attr.function || sym->attr.result) && sym->as)
16246 gfc_resolve_array_spec (sym->as, check_constant);
16252 if (sym->formal_ns && sym->formal_ns != gfc_current_ns
16253 && !sym->attr.contained && !sym->attr.intrinsic)
16254 gfc_resolve (sym->formal_ns);
16257 if (sym->formal && !sym->formal_ns)
16259 gfc_formal_arglist *formal = sym->formal;
16260 while (formal && !formal->sym)
16265 sym->formal_ns = formal->sym->ns;
16266 if (sym->formal_ns && sym->ns != formal->sym->ns)
16267 sym->formal_ns->refs++;
16272 if (sym->attr.threadprivate
16273 && !(sym->attr.save || sym->attr.data || sym->attr.in_common)
16274 && !(sym->ns->save_all && !sym->attr.automatic)
16275 && sym->module == NULL
16276 && (sym->ns->proc_name == NULL
16277 || (sym->ns->proc_name->attr.flavor != FL_MODULE
16278 && !sym->ns->proc_name->attr.is_main_program)))
16279 gfc_error ("Threadprivate at %L isn't SAVEd", &sym->declared_at);
16282 if (sym->attr.omp_declare_target
16283 && sym->attr.flavor == FL_VARIABLE
16284 && !sym->attr.save
16285 && !(sym->ns->save_all && !sym->attr.automatic)
16286 && (!sym->attr.in_common
16287 && sym->module == NULL
16288 && (sym->ns->proc_name == NULL
16289 || (sym->ns->proc_name->attr.flavor != FL_MODULE
16290 && !sym->ns->proc_name->attr.is_main_program))))
16292 sym->name, &sym->declared_at);
16297 if (sym->ts.type == BT_DERIVED
16298 && !sym->value
16299 && !sym->attr.allocatable
16300 && !sym->attr.alloc_comp)
16302 symbol_attribute *a = &sym->attr;
16309 || sym->ts.u.derived->attr.alloc_comp
16310 || sym->ts.u.derived->attr.pointer_comp))
16311 && !(a->function && sym != sym->result))
16313 && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY))
16314 apply_default_init (sym);
16315 else if (a->function && sym->result && a->access != ACCESS_PRIVATE
16316 && (sym->ts.u.derived->attr.alloc_comp
16317 || sym->ts.u.derived->attr.pointer_comp))
16320 sym->result->attr.referenced = 1;
16323 if (sym->ts.type == BT_CLASS && sym->ns == gfc_current_ns
16324 && sym->attr.dummy && sym->attr.intent == INTENT_OUT
16325 && sym->ns->proc_name->attr.if_source != IFSRC_IFBODY
16326 && !CLASS_DATA (sym)->attr.class_pointer
16327 && !CLASS_DATA (sym)->attr.allocatable)
16328 apply_default_init (sym);
16331 if (sym->attr.flavor == FL_VARIABLE || sym->attr.flavor == FL_PARAMETER
16332 || (sym->attr.flavor == FL_PROCEDURE && sym->attr.function))
16333 if (!resolve_typespec_used (&sym->ts, &sym->declared_at, sym->name))
16336 if (sym->param_list)
16337 resolve_pdt (sym);
16382 gfc_symbol *sym;
16402 sym = e->symtree->n.sym;
16404 if (sym->ns->is_block_data && !sym->attr.in_common)
16407 sym->name, &sym->declared_at);
16411 if (e->ref == NULL && sym->as)
16414 " declaration", sym->name, where);
16420 gfc_error ("DATA element %qs at %L cannot have a coindex", sym->name,
16425 has_pointer = sym->attr.pointer;
16437 "be a full array", sym->name, where);
16773 gfc_impure_variable (gfc_symbol *sym)
16778 if (sym->attr.use_assoc || sym->attr.in_common)
16784 if (ns == sym->ns)
16786 if (ns->proc_name->attr.flavor == FL_PROCEDURE && !sym->attr.function)
16790 proc = sym->ns->proc_name;
16791 if (sym->attr.dummy
16792 && !sym->attr.value
16793 && ((proc->attr.subroutine && sym->attr.intent == INTENT_IN)
16808 gfc_pure (gfc_symbol *sym)
16813 if (sym == NULL)
16819 sym = ns->proc_name;
16820 if (sym == NULL)
16822 attr = sym->attr;
16829 attr = sym->attr;
16840 gfc_implicit_pure (gfc_symbol *sym)
16844 if (sym == NULL)
16850 sym = ns->proc_name;
16851 if (sym == NULL)
16854 if (sym->attr.flavor == FL_PROCEDURE)
16859 return sym->attr.flavor == FL_PROCEDURE && sym->attr.implicit_pure
16860 && !sym->attr.pure;
16865 gfc_unset_implicit_pure (gfc_symbol *sym)
16869 if (sym == NULL)
16875 sym = ns->proc_name;
16876 if (sym == NULL)
16879 if (sym->attr.flavor == FL_PROCEDURE)
16884 if (sym->attr.flavor == FL_PROCEDURE)
16885 sym->attr.implicit_pure = 0;
16887 sym->attr.pure = 0;
16894 gfc_elemental (gfc_symbol *sym)
16898 if (sym == NULL)
16899 sym = gfc_current_ns->proc_name;
16900 if (sym == NULL)
16902 attr = sym->attr;
17004 resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e)
17015 "attribute to be an EQUIVALENCE object", sym->name,
17024 "components to be an EQUIVALENCE object",sym->name,
17029 if (sym->attr.in_common && gfc_has_default_initializer (sym->ts.u.derived))
17033 "in COMMON", sym->name, &e->where);
17040 && (!resolve_equivalence_derived(c->ts.u.derived, sym, e)))
17049 sym->name, &e->where);
17073 gfc_symbol *sym;
17083 last_ts = &eq->expr->symtree->n.sym->ts;
17085 first_sym = eq->expr->symtree->n.sym;
17093 e->ts = e->symtree->n.sym->ts;
17100 sym = e->symtree->n.sym;
17102 if (sym->attr.dimension)
17104 ref->u.ar.as = sym->as;
17159 sym = e->symtree->n.sym;
17161 if (sym->attr.is_protected)
17173 if (sym->ns->proc_name
17174 && sym->ns->proc_name->attr.pure
17175 && sym->attr.in_common)
17180 if (sym->ns->use_stmts)
17183 for (r = sym->ns->use_stmts->rename; r; r = r->next)
17184 if (strcmp(r->use_name, sym->name) == 0) saw_sym = true;
17192 sym->name, &e->where, sym->ns->proc_name->name);
17200 "object", sym->name, &e->where);
17205 && !resolve_equivalence_derived (e->ts.u.derived, sym, e))
17220 if (object == 1 || gfc_compare_types (last_ts, &sym->ts))
17224 eq_type = sequence_type (sym->ts);
17235 && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where)))
17244 && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where)))
17251 && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where))
17258 && !gfc_notify_std (GFC_STD_GNU, msg, sym->name, &e->where))
17263 last_ts =&sym->ts;
17270 if (e->ref->type == REF_ARRAY && is_non_constant_shape_array (sym))
17273 "an EQUIVALENCE object", sym->name, &e->where);
17310 gfc_symbol *sym,
17318 s = expr->symtree->n.sym;
17323 if (sym == s)
17326 "for %qs at %L", sym->name, &expr->where);
17341 st->n.sym = s;
17366 gfc_symbol *sym;
17372 synthetic symbol and ns->entries->sym actual FUNCTION symbol. */
17374 sym = ns->entries->sym;
17376 sym = ns->proc_name;
17377 if (sym->result == sym
17378 && sym->ts.type == BT_UNKNOWN
17379 && !gfc_set_default_type (sym, 0, NULL)
17380 && !sym->attr.untyped)
17383 sym->name, &sym->declared_at);
17384 sym->attr.untyped = 1;
17387 if (sym->ts.type == BT_DERIVED && !sym->ts.u.derived->attr.use_assoc
17388 && !sym->attr.contained
17389 && !gfc_check_symbol_access (sym->ts.u.derived)
17390 && gfc_check_symbol_access (sym))
17393 "%L of PRIVATE type %qs", sym->name,
17394 &sym->declared_at, sym->ts.u.derived->name);
17400 if (el->sym->result == el->sym
17401 && el->sym->ts.type == BT_UNKNOWN
17402 && !gfc_set_default_type (el->sym, 0, NULL)
17403 && !el->sym->attr.untyped)
17406 el->sym->name, &el->sym->declared_at);
17407 el->sym->attr.untyped = 1;
17411 if (sym->ts.type == BT_CHARACTER
17412 && sym->ts.u.cl->length
17413 && sym->ts.u.cl->length->ts.type == BT_INTEGER)
17414 gfc_traverse_expr (sym->ts.u.cl->length, sym, flag_fn_result_spec, 0);
17421 check_uop_procedure (gfc_symbol *sym, locus where)
17425 if (!sym->attr.function)
17428 sym->name, &where);
17432 if (sym->ts.type == BT_CHARACTER
17433 && !((sym->ts.u.cl && sym->ts.u.cl->length) || sym->ts.deferred)
17434 && !(sym->result && ((sym->result->ts.u.cl
17435 && sym->result->ts.u.cl->length) || sym->result->ts.deferred)))
17438 "character length", sym->name, &where);
17442 formal = gfc_sym_get_dummy_args (sym);
17443 if (!formal || !formal->sym)
17446 "one argument", sym->name, &where);
17450 if (formal->sym->attr.intent != INTENT_IN)
17457 if (formal->sym->attr.optional)
17465 if (!formal || !formal->sym)
17468 if (formal->sym->attr.intent != INTENT_IN)
17475 if (formal->sym->attr.optional)
17504 check_uop_procedure (itr->sym, itr->sym->declared_at);
Indexes created Sun Mar 01 05:31:48 UTC 2026