diff options
Diffstat (limited to 'gcc/fortran/resolve.c')
| -rw-r--r-- | gcc/fortran/resolve.c | 51 |
1 files changed, 36 insertions, 15 deletions
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 056ff0e..0b27da1 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1076,7 +1076,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype) if (!sym->attr.intrinsic && !(sym->attr.external || sym->attr.use_assoc || sym->attr.if_source == IFSRC_IFBODY) - && gfc_intrinsic_name (sym->name, sym->attr.subroutine)) + && gfc_is_intrinsic (sym, sym->attr.subroutine, e->where)) sym->attr.intrinsic = 1; if (sym->attr.proc == PROC_ST_FUNCTION) @@ -1535,7 +1535,7 @@ generic: /* Last ditch attempt. See if the reference is to an intrinsic that possesses a matching interface. 14.1.2.4 */ - if (sym && !gfc_intrinsic_name (sym->name, 0)) + if (sym && !gfc_is_intrinsic (sym, 0, expr->where)) { gfc_error ("There is no specific function for the generic '%s' at %L", expr->symtree->n.sym->name, &expr->where); @@ -1673,7 +1673,7 @@ resolve_unknown_f (gfc_expr *expr) /* See if we have an intrinsic function reference. */ - if (gfc_intrinsic_name (sym->name, 0)) + if (gfc_is_intrinsic (sym, 0, expr->where)) { if (gfc_intrinsic_func_interface (expr, 1) == MATCH_YES) return SUCCESS; @@ -1721,13 +1721,13 @@ is_external_proc (gfc_symbol *sym) { if (!sym->attr.dummy && !sym->attr.contained && !(sym->attr.intrinsic - || gfc_intrinsic_name (sym->name, sym->attr.subroutine)) + || gfc_is_intrinsic (sym, sym->attr.subroutine, sym->declared_at)) && sym->attr.proc != PROC_ST_FUNCTION && !sym->attr.use_assoc && sym->name) return true; - else - return false; + + return false; } @@ -2469,7 +2469,7 @@ generic: that possesses a matching interface. 14.1.2.4 */ sym = c->symtree->n.sym; - if (!gfc_intrinsic_name (sym->name, 1)) + if (!gfc_is_intrinsic (sym, 1, c->loc)) { gfc_error ("There is no specific subroutine for the generic '%s' at %L", sym->name, &c->loc); @@ -2748,7 +2748,7 @@ resolve_unknown_s (gfc_code *c) /* See if we have an intrinsic function reference. */ - if (gfc_intrinsic_name (sym->name, 1)) + if (gfc_is_intrinsic (sym, 1, c->loc)) { if (gfc_intrinsic_sub_interface (c, 1) == MATCH_YES) return SUCCESS; @@ -7961,24 +7961,45 @@ resolve_symbol (gfc_symbol *sym) type to avoid spurious warnings. */ if (sym->attr.flavor != FL_MODULE && sym->attr.intrinsic) { - if (gfc_intrinsic_name (sym->name, 0)) + gfc_intrinsic_sym* isym; + const char* symstd; + + /* We already know this one is an intrinsic, so we don't call + gfc_is_intrinsic for full checking but rather use gfc_find_function and + gfc_find_subroutine directly to check whether it is a function or + subroutine. */ + + if ((isym = gfc_find_function (sym->name))) { if (sym->ts.type != BT_UNKNOWN && gfc_option.warn_surprising) - gfc_warning ("Type specified for intrinsic function '%s' at %L is ignored", - sym->name, &sym->declared_at); + gfc_warning ("Type specified for intrinsic function '%s' at %L is" + " ignored", sym->name, &sym->declared_at); } - else if (gfc_intrinsic_name (sym->name, 1)) + else if ((isym = gfc_find_subroutine (sym->name))) { if (sym->ts.type != BT_UNKNOWN) { - gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type specifier", - sym->name, &sym->declared_at); + gfc_error ("Intrinsic subroutine '%s' at %L shall not have a type" + " specifier", sym->name, &sym->declared_at); return; } } else { - gfc_error ("Intrinsic '%s' at %L does not exist", sym->name, &sym->declared_at); + gfc_error ("'%s' declared INTRINSIC at %L does not exist", + sym->name, &sym->declared_at); + return; + } + + /* Check it is actually available in the standard settings. */ + if (gfc_check_intrinsic_standard (isym, &symstd, false, sym->declared_at) + == FAILURE) + { + gfc_error ("The intrinsic '%s' declared INTRINSIC at %L is not" + " available in the current standard settings but %s. Use" + " an appropriate -std=* option or enable -fall-intrinsics" + " in order to use it.", + sym->name, &sym->declared_at, symstd); return; } } |