Hi all,
this patch is a fix for PR 33141. Summary, open for discussion and
suggestions in addition to code review:
1.) New -Wintrinsic-shadow warning enabled with -Wall that warns if a
user-defined procedure has the same name as an intrinsic in the
selected
-std=*; messages are as suggested by Tobias Burnus in the bug-page.
2.) Previously, using an intrinsic not part of the selected -std=*
emitted an error if -Wnonstd-intrinsics was defined but did not
diagnose
anything otherwise; this is obviously bad behaviour, as errors for
invalid programs should not depend on warning flags; at least that
feels
completely wrong for me.
I changed the handling of intrinsics not part of the selected
standard,
so that gfortran handles such procedures as if declared EXTERNAL; that
is, although there exists an intrinsic of the same name in another
standard, gfortran now tries to link to a user-supplied procedure with
the specified name. This can be avoided entirely by defining
-fall-intrinsics or by selecting an appropriate -std=* option. I
believe this behaviour is consistent and good; 'ASINH' was no
intrinsic
before Fortran 2008 and thus I don't see what should be wrong with
this
program, compiled with -std=f2003:
REAL FUNCTION asinh (arg)
REAL :: arg
asinh = arg
END FUNCTION asinh
PROGRAM main
IF (ASINH (1.) /= 1.) THEN
WRITE (*,*) "Error"
END IF
END PROGRAM main
There's also a new option -Wintrinsics-std (enabled at -Wall) that
warns
whenever a called procedure is treated as EXTERNAL despite having the
same name as an intrinsic because of this new behaviour.
The patch was regression tested and bootstrapped on GNU/Linux-x86-32
without any failures. Ok to commit?
Comments on how to improve the behaviour further, the option-names,
documentation texts, diagnostic messages and such are very welcome ;)
Cheers,
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
2008-07-21 Daniel Kraft <d@domob.eu>
PR fortran/33141
* lang.opt (Wnonstd-intrinsics): Removed option.
(Wintrinsics-std), (Wintrinsic-shadow): New options.
* invoke.texi (Option Summary): Removed -Wnonstd-intrinsics
from the list and added -Wintrinsics-std and -Wintrinsic-shadow.
(Error and Warning Options): Documented the new options and removed
the documentation for -Wnonstd-intrinsics.
* gfortran.h (gfc_option_t): New members warn_intrinsic_shadow and
warn_intrinsics_std, removed warn_nonstd_intrinsics.
(gfc_is_intrinsic): Renamed from gfc_intrinsic_name.
(gfc_warn_intrinsic_shadow), (gfc_check_intrinsic_standard): New.
* decl.c (match_procedure_decl): Replaced gfc_intrinsic_name by
the new name gfc_is_intrinsic.
(warn_intrinsic_shadow): New helper method.
(gfc_match_function_decl), (gfc_match_subroutine): Call the new
method
warn_intrinsic_shadow to check the just-parsed procedure.
* expr.c (check_init_expr): Call new gfc_is_intrinsic to check
whether
the function called is really an intrinsic in the selected standard.
* intrinsic.c (gfc_is_intrinsic): Renamed from gfc_intrinsic_name
and
extended to take into account the selected standard settings when
trying
to find out whether a symbol is an intrinsic or not.
(gfc_check_intrinsic_standard): Made public and extended.
(gfc_intrinsic_func_interface), (gfc_intrinsic_sub_interface):
Removed
the calls to check_intrinsic_standard, this check now happens inside
gfc_is_intrinsic.
(gfc_warn_intrinsic_shadow): New method defined.
* options.c (gfc_init_options): Initialize new warning flags to
false
and removed intialization of Wnonstd-intrinsics flag.
(gfc_post_options): Removed logic for Wnonstd-intrinsics flag.
(set_Wall): Set new warning flags and removed Wnonstd-intrinsics
flag.
(gfc_handle_option): Handle the new flags and removed handling of
the
old Wnonstd-intrinsics flag.
* primary.c (gfc_match_rvalue): Replaced call to
gfc_intrinsic_name by
the new name gfc_is_intrinsic.
* resolve.c (resolve_actual_arglist): Ditto.
(resolve_generic_f), (resolve_unknown_f): Ditto.
(is_external_proc): Ditto.
(resolve_generic_s), (resolve_unknown_s): Ditto.
(resolve_symbol): Ditto and ensure for symbols declared INTRINSIC
that
they are really available in the selected standard setting.
2008-07-21 Daniel Kraft <d@domob.eu>
PR fortran/33141
* gfortran.dg/intrinsic_shadow_1.f03: New test for -Wintrinsic-
shadow.
* gfortran.dg/intrinsic_shadow_2.f03: Ditto.
* gfortran.dg/intrinsic_shadow_3.f03: Ditto.
* gfortran.dg/intrinsic_std_1.f90: New test for -Wintrinsics-std.
* gfortran.dg/intrinsic_std_2.f90: Ditto.
* gfortran.dg/intrinsic_std_3.f90: Ditto.
* gfortran.dg/intrinsic_std_4.f90: Ditto.
* gfortran.dg/warn_std_1.f90: Removed option -Wnonstd-intrinsics.
* gfortran.dg/warn_std_2.f90: Replaced -Wnonstd-intrinsics by
-Wintrinsics-std and adapted expected errors/warnings.
* gfortran.dg/warn_std_3.f90: Ditto.
* gfortran.dg/c_sizeof_2.f90: Adapted expected error/warning
message.
* gfortran.dg/gamma_2.f90: Ditto.
* gfortran.dg/selected_char_kind_3.f90: Ditto.
* gfortran.dg/fmt_g0_2.f08: Call with -fall-intrinsics to allow
abort.
Index: gcc/fortran/intrinsic.c
===================================================================
--- gcc/fortran/intrinsic.c (revision 138006)
+++ 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 (%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,81 @@ check_specific (gfc_intrinsic_sym *speci
/* Check whether an intrinsic belongs to whatever standard the user
- has chosen. */
+ has chosen, taking also into accout -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",
+ "GNU extension" or "Obsolescent in Fortran 95") that can be
used to construct
+ a detailed warning/error message in case of 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 = "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 = "GNU Fortran extension";
+ break;
+
+ case GFC_STD_LEGACY:
+ symstd_msg = "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' (%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 +3600,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 +3694,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 +3913,42 @@ gfc_convert_chartype (gfc_expr *expr, gf
return SUCCESS;
}
+
+
+/* Check if the passed name is name of an intrinsic (taking into
accout 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 138006)
+++ 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 138006)
+++ 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 138006)
+++ 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 138006)
+++ 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 138006)
+++ 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 138006)
+++ 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,44 @@ 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' (%s) declared INTRINSIC at %L is
not"
+ " available in the current standard settings. Use an"
+ " appropriate -std=* option or enable -fall-intrinsics in"
+ " order to use it.", sym->name, symstd, &sym->declared_at);
return;
}
}
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c (revision 138006)
+++ 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 138006)
+++ 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
138006)
+++ 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 138006)
+++ 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 138006)
+++ 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 138006)
+++ 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 138006)
+++ 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 138006)
+++ 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 138006)
+++ 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>