This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: [PATCH, Fortran] PR 33141: Better diagnostics and handling of intrinsics with -std=* settings
FYI, that's the updated patch for the changes described below.
Daniel
Daniel Kraft wrote:
Tobias Burnus wrote:
"Warning: The intrinsic 'abort' at (1) is not included in the selected
standard (GNU Fortran extension) and 'abort' will be treated as if
declared EXTERNAL. Use an appropriate -std=* option or define
-fall-intrinsics to allow this intrinsic."
"in the selected standard (GNU Fortran exension)" sounds as if one used
-std=gnu instead of, e.g., -std=f95. Additionally, warning/error
messages in gfortran do not end with a ".". Maybe better:
"Warning: 'abort' at (1) is not an intrinsic in the selected standard
but a GNU extension. It will be treated as if declared EXTERNAL. Use
an appropriate -std=* option or define -fall-intrinsics to allow this
intrinsic"
But maybe someone else comes up with an even better wording.
I tried to get something easy to translate and language-independent
(because those "GNU Fortran extension", "new in Fortran 2003" and such
are substituted), but you're right. I suggest to change those
standard-names to
"a GNU Fortran extension", "new in XXX", "for backwards compatibility"...
so that we can do use your suggested message:
is not an intrinsic in...but %s. It will...
Is this ok, even for a translator's point of view? At least for German,
where I can tell, this can be translated fairly straight:
"eine GNU Fortran Erweiterung", "neu in XXX", "für Legacy-Code gedacht"...
ist nicht im gewählten Standard enthalten, sondern %s.
which works out well.
+/* Check if the passed name is name of an intrinsic (taking into accout
the
Spelling: account
Oops, will be changed of course.
The patch was regression tested and bootstrapped on GNU/Linux-x86-32
without any failures. Ok to commit?
OK. But maybe wait one day or two to give other a chance to comment.
I'll check it in tomorrow evening (europe) if no updates.
Can you additionally update
http://gcc.gnu.org/wiki/GFortran#news
(At some point we need to convert those items into a patch for
http://gcc.gnu.org/gcc-4.4/changes.html )
Ok, I'll update the wiki with the new/removed flag(s).
Thanks for the review,
Daniel
--
Done: Arc-Bar-Sam-Val-Wiz, Dwa-Elf-Gno-Hum-Orc, Law-Neu-Cha, Fem-Mal
Underway: Cav-Dwa-Law-Fem
To go: Cav-Hea-Kni-Mon-Pri-Ran-Rog-Tou
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c (revision 138065)
+++ gcc/fortran/intrinsic.c (working copy)
@@ -807,15 +807,47 @@ gfc_intrinsic_actual_ok (const char *nam
}
-/* Given a string, figure out if it is the name of an intrinsic
- subroutine or function. There are no generic intrinsic
- subroutines, they are all specific. */
+/* Given a symbol, find out if it is (and is to be treated) an intrinsic. If
+ it's name refers to an intrinsic but this intrinsic is not included in the
+ selected standard, this returns FALSE and sets the symbol's external
+ attribute. */
+
+bool
+gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
+{
+ gfc_intrinsic_sym* isym;
+ const char* symstd;
+
+ /* If INTRINSIC/EXTERNAL state is already known, return. */
+ if (sym->attr.intrinsic)
+ return true;
+ if (sym->attr.external)
+ return false;
-int
-gfc_intrinsic_name (const char *name, int subroutine_flag)
-{
- return subroutine_flag ? gfc_find_subroutine (name) != NULL
- : gfc_find_function (name) != NULL;
+ if (subroutine_flag)
+ isym = gfc_find_subroutine (sym->name);
+ else
+ isym = gfc_find_function (sym->name);
+
+ /* No such intrinsic available at all? */
+ if (!isym)
+ return false;
+
+ /* See if this intrinsic is allowed in the current standard. */
+ if (gfc_check_intrinsic_standard (isym, &symstd, false, loc) == FAILURE)
+ {
+ if (gfc_option.warn_intrinsics_std)
+ gfc_warning_now ("The intrinsic '%s' at %L is not included in the"
+ " selected standard but %s and '%s' will be treated as"
+ " if declared EXTERNAL. Use an appropriate -std=*"
+ " option or define -fall-intrinsics to allow this"
+ " intrinsic.", sym->name, &loc, symstd, sym->name);
+ sym->attr.external = 1;
+
+ return false;
+ }
+
+ return true;
}
@@ -3448,21 +3480,82 @@ check_specific (gfc_intrinsic_sym *speci
/* Check whether an intrinsic belongs to whatever standard the user
- has chosen. */
+ has chosen, taking also into account -fall-intrinsics. Here, no
+ warning/error is emitted; but if symstd is not NULL, it is pointed to a
+ textual representation of the symbols standard status (like
+ "new in Fortran 2008", "a GNU extension" or "obsolescent in Fortran 95") that
+ can be used to construct a detailed warning/error message in case of
+ a FAILURE. */
-static try
-check_intrinsic_standard (const char *name, int standard, locus *where)
+try
+gfc_check_intrinsic_standard (const gfc_intrinsic_sym* isym,
+ const char** symstd, bool silent, locus where)
{
- /* Do not warn about GNU-extensions if -std=gnu. */
- if (!gfc_option.warn_nonstd_intrinsics
- || (standard == GFC_STD_GNU && gfc_option.warn_std & GFC_STD_GNU))
+ const char* symstd_msg;
+
+ /* For -fall-intrinsics, just succeed. */
+ if (gfc_option.flag_all_intrinsics)
return SUCCESS;
- if (gfc_notify_std (standard, "Intrinsic '%s' at %L is not included "
- "in the selected standard", name, where) == FAILURE)
- return FAILURE;
+ /* Find the symbol's standard message for later usage. */
+ switch (isym->standard)
+ {
+ case GFC_STD_F77:
+ symstd_msg = "available since Fortran 77";
+ break;
- return SUCCESS;
+ case GFC_STD_F95_OBS:
+ symstd_msg = "obsolescent in Fortran 95";
+ break;
+
+ case GFC_STD_F95_DEL:
+ symstd_msg = "deleted in Fortran 95";
+ break;
+
+ case GFC_STD_F95:
+ symstd_msg = "new in Fortran 95";
+ break;
+
+ case GFC_STD_F2003:
+ symstd_msg = "new in Fortran 2003";
+ break;
+
+ case GFC_STD_F2008:
+ symstd_msg = "new in Fortran 2008";
+ break;
+
+ case GFC_STD_GNU:
+ symstd_msg = "a GNU Fortran extension";
+ break;
+
+ case GFC_STD_LEGACY:
+ symstd_msg = "for backward compatibility";
+ break;
+
+ default:
+ gfc_internal_error ("Invalid standard code on intrinsic '%s' (%d)",
+ isym->name, isym->standard);
+ }
+
+ /* If warning about the standard, warn and succeed. */
+ if (gfc_option.warn_std & isym->standard)
+ {
+ /* Do only print a warning if not a GNU extension. */
+ if (!silent && isym->standard != GFC_STD_GNU)
+ gfc_warning ("Intrinsic '%s' (is %s) is used at %L",
+ isym->name, _(symstd_msg), &where);
+
+ return SUCCESS;
+ }
+
+ /* If allowing the symbol's standard, succeed, too. */
+ if (gfc_option.allow_std & isym->standard)
+ return SUCCESS;
+
+ /* Otherwise, fail. */
+ if (symstd)
+ *symstd = _(symstd_msg);
+ return FAILURE;
}
@@ -3508,9 +3601,6 @@ gfc_intrinsic_func_interface (gfc_expr *
return MATCH_NO;
}
- if (check_intrinsic_standard (name, isym->standard, &expr->where) == FAILURE)
- return MATCH_ERROR;
-
if ((isym->id == GFC_ISYM_REAL || isym->id == GFC_ISYM_DBLE
|| isym->id == GFC_ISYM_CMPLX)
&& gfc_init_expr
@@ -3605,9 +3695,6 @@ gfc_intrinsic_sub_interface (gfc_code *c
if (isym == NULL)
return MATCH_NO;
- if (check_intrinsic_standard (name, isym->standard, &c->loc) == FAILURE)
- return MATCH_ERROR;
-
gfc_suppress_error = !error_flag;
init_arglist (isym);
@@ -3827,3 +3914,42 @@ gfc_convert_chartype (gfc_expr *expr, gf
return SUCCESS;
}
+
+
+/* Check if the passed name is name of an intrinsic (taking into account the
+ current -std=* and -fall-intrinsic settings). If it is, see if we should
+ warn about this as a user-procedure having the same name as an intrinsic
+ (-Wintrinsic-shadow enabled) and do so if we should. */
+
+void
+gfc_warn_intrinsic_shadow (const gfc_symbol* sym, bool in_module, bool func)
+{
+ gfc_intrinsic_sym* isym;
+
+ /* If the warning is disabled, do nothing at all. */
+ if (!gfc_option.warn_intrinsic_shadow)
+ return;
+
+ /* Try to find an intrinsic of the same name. */
+ if (func)
+ isym = gfc_find_function (sym->name);
+ else
+ isym = gfc_find_subroutine (sym->name);
+
+ /* If no intrinsic was found with this name or it's not included in the
+ selected standard, everything's fine. */
+ if (!isym || gfc_check_intrinsic_standard (isym, NULL, true,
+ sym->declared_at) == FAILURE)
+ return;
+
+ /* Emit the warning. */
+ if (in_module)
+ gfc_warning ("'%s' declared at %L may shadow the intrinsic of the same"
+ " name. In order to call the intrinsic, explicit INTRINSIC"
+ " declarations may be required.",
+ sym->name, &sym->declared_at);
+ else
+ gfc_warning ("'%s' declared at %L is also the name of an intrinsic. It can"
+ " only be called via an explicit interface or if declared"
+ " EXTERNAL.", sym->name, &sym->declared_at);
+}
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (revision 138065)
+++ gcc/fortran/decl.c (working copy)
@@ -4120,8 +4120,8 @@ match_procedure_decl (void)
/* Handle intrinsic procedures. */
if (!(proc_if->attr.external || proc_if->attr.use_assoc
|| proc_if->attr.if_source == IFSRC_IFBODY)
- && (gfc_intrinsic_name (proc_if->name, 0)
- || gfc_intrinsic_name (proc_if->name, 1)))
+ && (gfc_is_intrinsic (proc_if, 0, gfc_current_locus)
+ || gfc_is_intrinsic (proc_if, 1, gfc_current_locus)))
proc_if->attr.intrinsic = 1;
if (proc_if->attr.intrinsic
&& !gfc_intrinsic_actual_ok (proc_if->name, 0))
@@ -4336,6 +4336,22 @@ gfc_match_procedure (void)
}
+/* Warn if a matched procedure has the same name as an intrinsic; this is
+ simply a wrapper around gfc_warn_intrinsic_shadow that interprets the current
+ parser-state-stack to find out whether we're in a module. */
+
+static void
+warn_intrinsic_shadow (const gfc_symbol* sym, bool func)
+{
+ bool in_module;
+
+ in_module = (gfc_state_stack->previous
+ && gfc_state_stack->previous->state == COMP_MODULE);
+
+ gfc_warn_intrinsic_shadow (sym, in_module, func);
+}
+
+
/* Match a function declaration. */
match
@@ -4460,6 +4476,9 @@ gfc_match_function_decl (void)
sym->result = result;
}
+ /* Warn if this procedure has the same name as an intrinsic. */
+ warn_intrinsic_shadow (sym, true);
+
return MATCH_YES;
}
@@ -4842,6 +4861,9 @@ gfc_match_subroutine (void)
if (copy_prefix (&sym->attr, &sym->declared_at) == FAILURE)
return MATCH_ERROR;
+ /* Warn if it has the same name as an intrinsic. */
+ warn_intrinsic_shadow (sym, false);
+
return MATCH_YES;
}
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h (revision 138065)
+++ gcc/fortran/gfortran.h (working copy)
@@ -1872,6 +1872,8 @@ typedef struct
int warn_surprising;
int warn_tabs;
int warn_underflow;
+ int warn_intrinsic_shadow;
+ int warn_intrinsics_std;
int warn_character_truncation;
int max_errors;
@@ -1914,7 +1916,6 @@ typedef struct
int warn_std;
int allow_std;
- int warn_nonstd_intrinsics;
int fshort_enums;
int convert;
int record_marker;
@@ -2254,7 +2255,7 @@ try gfc_convert_type_warn (gfc_expr *, g
try gfc_convert_chartype (gfc_expr *, gfc_typespec *);
int gfc_generic_intrinsic (const char *);
int gfc_specific_intrinsic (const char *);
-int gfc_intrinsic_name (const char *, int);
+bool gfc_is_intrinsic (gfc_symbol*, int, locus);
int gfc_intrinsic_actual_ok (const char *, const bool);
gfc_intrinsic_sym *gfc_find_function (const char *);
gfc_intrinsic_sym *gfc_find_subroutine (const char *);
@@ -2262,6 +2263,10 @@ gfc_intrinsic_sym *gfc_find_subroutine (
match gfc_intrinsic_func_interface (gfc_expr *, int);
match gfc_intrinsic_sub_interface (gfc_code *, int);
+void gfc_warn_intrinsic_shadow (const gfc_symbol*, bool, bool);
+try gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**,
+ bool, locus);
+
/* match.c -- FIXME */
void gfc_free_iterator (gfc_iterator *, int);
void gfc_free_forall_iterator (gfc_forall_iterator *);
Index: gcc/fortran/lang.opt
===================================================================
--- gcc/fortran/lang.opt (revision 138065)
+++ gcc/fortran/lang.opt (working copy)
@@ -92,9 +92,9 @@ Wline-truncation
Fortran Warning
Warn about truncated source lines
-Wnonstd-intrinsics
+Wintrinsics-std
Fortran Warning
-Warn about usage of non-standard intrinsics
+Warn on intrinsics not part of the selected standard
Wreturn-type
Fortran Warning
@@ -112,6 +112,10 @@ Wunderflow
Fortran Warning
Warn about underflow of numerical constant expressions
+Wintrinsic-shadow
+Fortran Warning
+Warn if a user-procedure has the same name as an intrinsic
+
cpp
Fortran Joined Separate Negative(nocpp)
Enable preprocessing
Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c (revision 138065)
+++ gcc/fortran/expr.c (working copy)
@@ -2160,7 +2160,6 @@ check_init_expr (gfc_expr *e)
{
match m;
try t;
- gfc_intrinsic_sym *isym;
if (e == NULL)
return SUCCESS;
@@ -2179,7 +2178,12 @@ check_init_expr (gfc_expr *e)
if ((m = check_specification_function (e)) != MATCH_YES)
{
- if ((m = gfc_intrinsic_func_interface (e, 0)) != MATCH_YES)
+ gfc_intrinsic_sym* isym;
+ gfc_symbol* sym;
+
+ sym = e->symtree->n.sym;
+ if (!gfc_is_intrinsic (sym, 0, e->where)
+ || (m = gfc_intrinsic_func_interface (e, 0)) != MATCH_YES)
{
gfc_error ("Function '%s' in initialization expression at %L "
"must be an intrinsic or a specification function",
@@ -2201,7 +2205,7 @@ check_init_expr (gfc_expr *e)
/* Try to scalarize an elemental intrinsic function that has an
array argument. */
- isym = gfc_find_function (e->symtree->n.sym->name);
+ isym = gfc_find_function (e->symtree->n.sym->name);
if (isym && isym->elemental
&& (t = scalarize_intrinsic_call (e)) == SUCCESS)
break;
Index: gcc/fortran/invoke.texi
===================================================================
--- gcc/fortran/invoke.texi (revision 138065)
+++ gcc/fortran/invoke.texi (working copy)
@@ -138,8 +138,8 @@ and warnings}.
@gccoptlist{-fmax-errors=@var{n} @gol
-fsyntax-only -pedantic -pedantic-errors @gol
-Wall -Waliasing -Wampersand -Wcharacter-truncation -Wconversion @gol
--Wimplicit-interface -Wline-truncation -Wnonstd-intrinsics -Wsurprising @gol
--Wno-tabs -Wunderflow -Wunused-parameter}
+-Wimplicit-interface -Wline-truncation -Wintrinsics-std -Wsurprising @gol
+-Wno-tabs -Wunderflow -Wunused-parameter -Wintrinsic-shadow}
@item Debugging Options
@xref{Debugging Options,,Options for debugging your program or GNU Fortran}.
@@ -211,7 +211,9 @@ form is determined by the file extension
Accept all of the intrinsic procedures provided in libgfortran
without regard to the setting of @option{-std}. In particular,
this option can be quite useful with @option{-std=f95}. Additionally,
-@command{gfortran} will ignore @option{-Wnonstd-intrinsics}.
+@command{gfortran} will ignore @option{-Wintrinsics-std} and will never try
+to link to an @code{EXTERNAL} version if the intrinsic is not included in the
+selected standard.
@item -fd-lines-as-code
@item -fd-lines-as-comments
@@ -662,8 +664,8 @@ warnings.
Enables commonly used warning options pertaining to usage that
we recommend avoiding and that we believe are easy to avoid.
This currently includes @option{-Waliasing},
-@option{-Wampersand}, @option{-Wsurprising}, @option{-Wnonstd-intrinsics},
-@option{-Wno-tabs}, and @option{-Wline-truncation}.
+@option{-Wampersand}, @option{-Wsurprising}, @option{-Wintrinsics-std},
+@option{-Wno-tabs}, @option{-Wintrinsic-shadow} and @option{-Wline-truncation}.
@item -Waliasing
@opindex @code{Waliasing}
@@ -721,11 +723,15 @@ Warn if a procedure is called without an
Note this only checks that an explicit interface is present. It does not
check that the declared interfaces are consistent across program units.
-@item -Wnonstd-intrinsics
-@opindex @code{Wnonstd-intrinsics}
+@item -Wintrinsics-std
+@opindex @code{Wintrinsics-std}
@cindex warnings, non-standard intrinsics
-Warn if the user tries to use an intrinsic that does not belong to the
-standard the user has chosen via the @option{-std} option.
+@cindex warnings, intrinsics of other standards
+Warn if @command{gfortran} finds a procedure named like an intrinsic not
+available in the currently selected standard (with @option{-std}) and treats
+it as @code{EXTERNAL} procedure because of this. @option{-fall-intrinsics} can
+be used to never trigger this behaviour and always link to the intrinsic
+regardless of the selected standard.
@item -Wsurprising
@opindex @code{Wsurprising}
@@ -765,6 +771,15 @@ is active for @option{-pedantic}, @optio
Produce a warning when numerical constant expressions are
encountered, which yield an UNDERFLOW during compilation.
+@item -Wintrinsic-shadow
+@opindex @code{Wintrinsic-shadow}
+@cindex warnings, intrinsic
+@cindex intrinsic
+Warn if a user-defined procedure or module procedure has the same name as an
+intrinsic; in this case, an explicit interface or @code{EXTERNAL} or
+@code{INTRINSIC} declaration might be needed to get calls later resolved to
+the desired intrinsic/procedure.
+
@item -Wunused-parameter
@opindex @code{Wunused-parameter}
@cindex warnings, unused parameter
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c (revision 138065)
+++ gcc/fortran/resolve.c (working copy)
@@ -1076,7 +1076,7 @@ resolve_actual_arglist (gfc_actual_argli
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;
}
}
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c (revision 138065)
+++ gcc/fortran/primary.c (working copy)
@@ -2413,8 +2413,8 @@ gfc_match_rvalue (gfc_expr **result)
goto function0;
if (sym->attr.flavor == FL_UNKNOWN) sym->attr.flavor = FL_PROCEDURE;
- if (gfc_intrinsic_name (sym->name, 0)
- || gfc_intrinsic_name (sym->name, 1))
+ if (gfc_is_intrinsic (sym, 0, gfc_current_locus)
+ || gfc_is_intrinsic (sym, 1, gfc_current_locus))
sym->attr.intrinsic = 1;
e = gfc_get_expr ();
e->expr_type = EXPR_VARIABLE;
Index: gcc/fortran/options.c
===================================================================
--- gcc/fortran/options.c (revision 138065)
+++ gcc/fortran/options.c (working copy)
@@ -75,6 +75,8 @@ gfc_init_options (unsigned int argc, con
gfc_option.warn_surprising = 0;
gfc_option.warn_tabs = 1;
gfc_option.warn_underflow = 1;
+ gfc_option.warn_intrinsic_shadow = 0;
+ gfc_option.warn_intrinsics_std = 0;
gfc_option.max_errors = 25;
gfc_option.flag_all_intrinsics = 0;
@@ -123,8 +125,6 @@ gfc_init_options (unsigned int argc, con
set_default_std_flags ();
- gfc_option.warn_nonstd_intrinsics = 0;
-
/* -fshort-enums can be default on some targets. */
gfc_option.fshort_enums = targetm.default_short_enums ();
@@ -354,9 +354,6 @@ gfc_post_options (const char **pfilename
gfc_option.warn_tabs = 0;
}
- if (gfc_option.flag_all_intrinsics)
- gfc_option.warn_nonstd_intrinsics = 0;
-
gfc_cpp_post_options ();
/* FIXME: return gfc_cpp_preprocess_only ();
@@ -378,10 +375,11 @@ set_Wall (int setting)
gfc_option.warn_aliasing = setting;
gfc_option.warn_ampersand = setting;
gfc_option.warn_line_truncation = setting;
- gfc_option.warn_nonstd_intrinsics = setting;
gfc_option.warn_surprising = setting;
gfc_option.warn_tabs = !setting;
gfc_option.warn_underflow = setting;
+ gfc_option.warn_intrinsic_shadow = setting;
+ gfc_option.warn_intrinsics_std = setting;
gfc_option.warn_character_truncation = setting;
set_Wunused (setting);
@@ -517,6 +515,10 @@ gfc_handle_option (size_t scode, const c
gfc_option.warn_underflow = value;
break;
+ case OPT_Wintrinsic_shadow:
+ gfc_option.warn_intrinsic_shadow = value;
+ break;
+
case OPT_fall_intrinsics:
gfc_option.flag_all_intrinsics = 1;
break;
@@ -778,8 +780,8 @@ gfc_handle_option (size_t scode, const c
gfc_option.warn_std = 0;
break;
- case OPT_Wnonstd_intrinsics:
- gfc_option.warn_nonstd_intrinsics = value;
+ case OPT_Wintrinsics_std:
+ gfc_option.warn_intrinsics_std = value;
break;
case OPT_fshort_enums:
Index: gcc/testsuite/gfortran.dg/selected_char_kind_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/selected_char_kind_3.f90 (revision 138065)
+++ gcc/testsuite/gfortran.dg/selected_char_kind_3.f90 (working copy)
@@ -1,10 +1,10 @@
! { dg-do compile }
-! { dg-options "-std=f95 -pedantic -Wall" }
+! { dg-options "-std=f95 -pedantic -Wall -Wno-intrinsics-std" }
!
! Check that SELECTED_CHAR_KIND is rejected with -std=f95
!
implicit none
- character(kind=selected_char_kind("ascii")) :: s ! { dg-error "is not included in the selected standard" }
+ character(kind=selected_char_kind("ascii")) :: s ! { dg-error "must be an intrinsic or a specification function" }
s = "" ! { dg-error "has no IMPLICIT type" }
print *, s
end
Index: gcc/testsuite/gfortran.dg/gamma_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/gamma_2.f90 (revision 138065)
+++ gcc/testsuite/gfortran.dg/gamma_2.f90 (working copy)
@@ -8,11 +8,11 @@
! PR fortran/32980
!
subroutine foo()
-intrinsic :: gamma
-intrinsic :: dgamma
-intrinsic :: lgamma
-intrinsic :: algama
-intrinsic :: dlgama
+intrinsic :: gamma ! { dg-error "Fortran 2008" }
+intrinsic :: dgamma ! { dg-error "extension" }
+intrinsic :: lgamma ! { dg-error "extension" }
+intrinsic :: algama ! { dg-error "extension" }
+intrinsic :: dlgama ! { dg-error "extension" }
integer, parameter :: sp = kind(1.0)
integer, parameter :: dp = kind(1.0d0)
@@ -20,13 +20,13 @@ integer, parameter :: dp = kind(1.0d0)
real(sp) :: rsp = 1.0_sp
real(dp) :: rdp = 1.0_dp
-rsp = gamma(rsp) ! FIXME "is not included in the selected standard"
-rdp = gamma(rdp) ! FIXME "is not included in the selected standard"
-rdp = dgamma(rdp) ! { dg-error "is not included in the selected standard" }
+rsp = gamma(rsp)
+rdp = gamma(rdp)
+rdp = dgamma(rdp)
-rsp = lgamma(rsp) ! { dg-error "is not included in the selected standard" }
-rdp = lgamma(rdp) ! { dg-error "is not included in the selected standard" }
-rsp = algama(rsp) ! { dg-error "is not included in the selected standard" }
-rdp = dlgama(rdp) ! { dg-error "is not included in the selected standard" }
+rsp = lgamma(rsp)
+rdp = lgamma(rdp)
+rsp = algama(rsp)
+rdp = dlgama(rdp)
end subroutine foo
end
Index: gcc/testsuite/gfortran.dg/intrinsic_shadow_1.f03
===================================================================
--- gcc/testsuite/gfortran.dg/intrinsic_shadow_1.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/intrinsic_shadow_1.f03 (revision 0)
@@ -0,0 +1,57 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -Wintrinsic-shadow" }
+
+! PR fortran/33141
+! Check that the expected warnings are emitted if a user-procedure has the same
+! name as an intrinsic, but only if it is matched by the current -std=*.
+
+MODULE testmod
+ IMPLICIT NONE
+
+CONTAINS
+
+ ! ASIN is an intrinsic
+ REAL FUNCTION asin (arg) ! { dg-warning "shadow the intrinsic" }
+ IMPLICIT NONE
+ REAL :: arg
+ END FUNCTION asin
+
+ ! ASINH is one but not in F2003
+ REAL FUNCTION asinh (arg) ! { dg-bogus "shadow the intrinsic" }
+ IMPLICIT NONE
+ REAL :: arg
+ END FUNCTION asinh
+
+END MODULE testmod
+
+! ACOS is an intrinsic
+REAL FUNCTION acos (arg) ! { dg-warning "of an intrinsic" }
+ IMPLICIT NONE
+ REAL :: arg
+END FUNCTION acos
+
+! ACOSH not for F2003
+REAL FUNCTION acosh (arg) ! { dg-bogus "of an intrinsic" }
+ IMPLICIT NONE
+ REAL :: arg
+END FUNCTION acosh
+
+! A subroutine with the same name as an intrinsic subroutine
+SUBROUTINE random_number (arg) ! { dg-warning "of an intrinsic" }
+ IMPLICIT NONE
+ REAL, INTENT(OUT) :: arg
+END SUBROUTINE random_number
+
+! But a subroutine with the name of an intrinsic function is ok.
+SUBROUTINE atan (arg) ! { dg-bogus "of an intrinsic" }
+ IMPLICIT NONE
+ REAL :: arg
+END SUBROUTINE atan
+
+! As should be a function with the name of an intrinsic subroutine.
+REAL FUNCTION random_seed () ! { dg-bogus "of an intrinsic" }
+END FUNCTION random_seed
+
+! We do only compile, so no main program needed.
+
+! { dg-final { cleanup-modules "testmod" } }
Index: gcc/testsuite/gfortran.dg/intrinsic_shadow_2.f03
===================================================================
--- gcc/testsuite/gfortran.dg/intrinsic_shadow_2.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/intrinsic_shadow_2.f03 (revision 0)
@@ -0,0 +1,29 @@
+! { dg-do compile }
+! { dg-options "-std=f2003 -Wintrinsic-shadow -fall-intrinsics" }
+
+! PR fortran/33141
+! Check that the expected warnings are emitted if a user-procedure has the same
+! name as an intrinsic, with -fall-intrinsics even regardless of std=*.
+
+MODULE testmod
+ IMPLICIT NONE
+
+CONTAINS
+
+ ! ASINH is one but not in F2003
+ REAL FUNCTION asinh (arg) ! { dg-warning "shadow the intrinsic" }
+ IMPLICIT NONE
+ REAL :: arg
+ END FUNCTION asinh
+
+END MODULE testmod
+
+! ACOSH not for F2003
+REAL FUNCTION acosh (arg) ! { dg-warning "of an intrinsic" }
+ IMPLICIT NONE
+ REAL :: arg
+END FUNCTION acosh
+
+! We do only compile, so no main program needed.
+
+! { dg-final { cleanup-modules "testmod" } }
Index: gcc/testsuite/gfortran.dg/intrinsic_shadow_3.f03
===================================================================
--- gcc/testsuite/gfortran.dg/intrinsic_shadow_3.f03 (revision 0)
+++ gcc/testsuite/gfortran.dg/intrinsic_shadow_3.f03 (revision 0)
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-Wno-intrinsic-shadow -fall-intrinsics" }
+
+! PR fortran/33141
+! Check that the "intrinsic shadow" warnings are not emitted if the warning
+! is negated.
+
+MODULE testmod
+ IMPLICIT NONE
+
+CONTAINS
+
+ REAL FUNCTION asin (arg) ! { dg-bogus "shadow the intrinsic" }
+ IMPLICIT NONE
+ REAL :: arg
+ END FUNCTION asin
+
+END MODULE testmod
+
+REAL FUNCTION acos (arg) ! { dg-bogus "of an intrinsic" }
+ IMPLICIT NONE
+ REAL :: arg
+END FUNCTION acos
+
+! We do only compile, so no main program needed.
+
+! { dg-final { cleanup-modules "testmod" } }
Index: gcc/testsuite/gfortran.dg/intrinsic_std_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/intrinsic_std_1.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/intrinsic_std_1.f90 (revision 0)
@@ -0,0 +1,48 @@
+! { dg-do compile }
+! { dg-options "-std=f95 -Wintrinsics-std -fdump-tree-original" }
+
+! PR fortran/33141
+! Check for the expected behaviour when an intrinsic function/subroutine is
+! called that is not available in the defined standard or that is a GNU
+! extension:
+! There should be a warning emitted on the call, and the reference should be
+! treated like an external call.
+! For declaring a non-standard intrinsic INTRINSIC, a hard error should be
+! generated, of course.
+
+SUBROUTINE no_implicit
+ IMPLICIT NONE
+ REAL :: asinh ! { dg-warning "Fortran 2008" }
+
+ ! abort is a GNU extension
+ CALL abort () ! { dg-warning "extension" }
+
+ ! ASINH is an intrinsic of F2008
+ ! The warning should be issued in the declaration above where it is declared
+ ! EXTERNAL.
+ WRITE (*,*) ASINH (1.) ! { dg-bogus "Fortran 2008" }
+END SUBROUTINE no_implicit
+
+SUBROUTINE implicit_type
+ ! acosh has implicit type
+
+ WRITE (*,*) ACOSH (1.) ! { dg-warning "Fortran 2008" }
+ WRITE (*,*) ACOSH (1.) ! { dg-bogus "Fortran 2008" }
+END SUBROUTINE implicit_type
+
+SUBROUTINE specification_expression
+ CHARACTER(KIND=selected_char_kind("ascii")) :: x
+! { dg-error "specification function" "" { target "*-*-*" } 34 }
+! { dg-warning "Fortran 2003" "" { target "*-*-*" } 34 }
+END SUBROUTINE specification_expression
+
+SUBROUTINE intrinsic_decl
+ IMPLICIT NONE
+ INTRINSIC :: atanh ! { dg-error "Fortran 2008" }
+ INTRINSIC :: abort ! { dg-error "extension" }
+END SUBROUTINE intrinsic_decl
+
+! Scan that really external functions are called.
+! { dg-final { scan-tree-dump " abort " "original" } }
+! { dg-final { scan-tree-dump " asinh " "original" } }
+! { dg-final { scan-tree-dump " acosh " "original" } }
Index: gcc/testsuite/gfortran.dg/warn_std_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/warn_std_1.f90 (revision 138065)
+++ gcc/testsuite/gfortran.dg/warn_std_1.f90 (working copy)
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-Wnonstd-intrinsics -std=gnu" }
+! { dg-options "-std=gnu" }
!
! PR fortran/32778 - pedantic warning: intrinsics that
! are GNU extensions not part of -std=gnu
Index: gcc/testsuite/gfortran.dg/intrinsic_std_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/intrinsic_std_2.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/intrinsic_std_2.f90 (revision 0)
@@ -0,0 +1,15 @@
+! { dg-do link }
+! { dg-options "-std=f95 -Wintrinsics-std -fall-intrinsics" }
+
+! PR fortran/33141
+! Check that -fall-intrinsics makes all intrinsics available.
+
+PROGRAM main
+ IMPLICIT NONE
+
+ ! abort is a GNU extension
+ CALL abort () ! { dg-bogus "extension" }
+
+ ! ASINH is an intrinsic of F2008
+ WRITE (*,*) ASINH (1.) ! { dg-bogus "Fortran 2008" }
+END PROGRAM main
Index: gcc/testsuite/gfortran.dg/warn_std_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/warn_std_2.f90 (revision 138065)
+++ gcc/testsuite/gfortran.dg/warn_std_2.f90 (working copy)
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-Wnonstd-intrinsics -std=f95" }
+! { dg-options "-std=f95 -Wintrinsics-std" }
!
! PR fortran/32778 - pedantic warning: intrinsics that
! are GNU extensions not part of -std=gnu
@@ -11,15 +11,15 @@ CHARACTER(len=255) :: tmp
REAL(8) :: x
! GNU extension, check overload of F77 standard intrinsic
-x = ZABS(CMPLX(0.0, 1.0, 8)) ! { dg-error "is not included in the selected standard" }
+x = ZABS(CMPLX(0.0, 1.0, 8)) ! { dg-warning "extension" }
! GNU extension
-CALL flush() ! { dg-error "is not included in the selected standard" }
+CALL flush() ! { dg-warning "extension" }
! F95
tmp = ADJUSTL(" gfortran ")
! F2003
-CALL GET_COMMAND (tmp) ! { dg-error "is not included in the selected standard" }
+CALL GET_COMMAND (tmp) ! { dg-warning "Fortran 2003" }
END
Index: gcc/testsuite/gfortran.dg/intrinsic_std_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/intrinsic_std_3.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/intrinsic_std_3.f90 (revision 0)
@@ -0,0 +1,15 @@
+! { dg-do link }
+! { dg-options "-std=gnu -Wintrinsics-std" }
+
+! PR fortran/33141
+! -std=gnu should allow every intrinsic.
+
+PROGRAM main
+ IMPLICIT NONE
+
+ ! abort is a GNU extension
+ CALL abort () ! { dg-bogus "extension" }
+
+ ! ASINH is an intrinsic of F2008
+ WRITE (*,*) ASINH (1.) ! { dg-bogus "Fortran 2008" }
+END PROGRAM main
Index: gcc/testsuite/gfortran.dg/warn_std_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/warn_std_3.f90 (revision 138065)
+++ gcc/testsuite/gfortran.dg/warn_std_3.f90 (working copy)
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-Wnonstd-intrinsics -std=f2003" }
+! { dg-options "-std=f2003 -Wintrinsics-std" }
!
! PR fortran/32778 - pedantic warning: intrinsics that
! are GNU extensions not part of -std=gnu
@@ -11,10 +11,10 @@ CHARACTER(len=255) :: tmp
REAL(8) :: x
! GNU extension, check overload of F77 standard intrinsic
-x = ZABS(CMPLX(0.0, 1.0, 8)) ! { dg-error "is not included in the selected standard" }
+x = ZABS(CMPLX(0.0, 1.0, 8)) ! { dg-warning "extension" }
! GNU extension
-CALL flush() ! { dg-error "is not included in the selected standard" }
+CALL flush() ! { dg-warning "extension" }
! F95
tmp = ADJUSTL(" gfortran ")
Index: gcc/testsuite/gfortran.dg/intrinsic_std_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/intrinsic_std_4.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/intrinsic_std_4.f90 (revision 0)
@@ -0,0 +1,46 @@
+! { dg-do run }
+! { dg-options "-std=f95 -Wno-intrinsics-std" }
+
+! PR fortran/33141
+! Check that calls to intrinsics not in the current standard are "allowed" and
+! linked to external procedures with that name.
+! Addionally, this checks that -Wno-intrinsics-std turns off the warning.
+
+SUBROUTINE abort ()
+ IMPLICIT NONE
+ WRITE (*,*) "Correct"
+END SUBROUTINE abort
+
+REAL FUNCTION asinh (arg)
+ IMPLICIT NONE
+ REAL :: arg
+
+ WRITE (*,*) "Correct"
+ asinh = arg
+END FUNCTION asinh
+
+SUBROUTINE implicit_none
+ IMPLICIT NONE
+ REAL :: asinh ! { dg-bogus "Fortran 2008" }
+ REAL :: x
+
+ ! Both times our version above should be called
+ CALL abort () ! { dg-bogus "extension" }
+ x = ASINH (1.) ! { dg-bogus "Fortran 2008" }
+END SUBROUTINE implicit_none
+
+SUBROUTINE implicit_type
+ ! ASINH has implicit type here
+ REAL :: x
+
+ ! Our version should be called
+ x = ASINH (1.) ! { dg-bogus "Fortran 2008" }
+END SUBROUTINE implicit_type
+
+PROGRAM main
+ ! This should give a total of three "Correct"s
+ CALL implicit_none ()
+ CALL implicit_type ()
+END PROGRAM main
+
+! { dg-output "Correct\.*Correct\.*Correct" }
Index: gcc/testsuite/gfortran.dg/c_sizeof_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/c_sizeof_2.f90 (revision 138065)
+++ gcc/testsuite/gfortran.dg/c_sizeof_2.f90 (working copy)
@@ -2,8 +2,7 @@
! { dg-options "-std=f2003 -Wall" }
! Support F2008's c_sizeof()
!
-integer(4) :: i, j(10)
-i = c_sizeof(i) ! { dg-error "not included in the selected standard" }
-i = c_sizeof(j) ! { dg-error "not included in the selected standard" }
+integer(4) :: i
+i = c_sizeof(i) ! { dg-warning "Fortran 2008" }
end
Index: gcc/testsuite/gfortran.dg/fmt_g0_2.f08
===================================================================
--- gcc/testsuite/gfortran.dg/fmt_g0_2.f08 (revision 138065)
+++ gcc/testsuite/gfortran.dg/fmt_g0_2.f08 (working copy)
@@ -1,5 +1,5 @@
! { dg-do run }
-! { dg-options "-std=f95 -pedantic" }
+! { dg-options "-std=f95 -pedantic -fall-intrinsics" }
! { dg-shouldfail "Zero width in format descriptor" }
! PR36420 Fortran 2008: g0 edit descriptor
! Test case provided by Jerry DeLisle <jvdelisle@gcc.gnu.org>