re PR fortran/33141 (Intrinsic procedures: Improve warning/error with -std=*)

2008-07-24  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-24  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.

From-SVN: r138122
This commit is contained in:
Daniel Kraft 2008-07-24 20:52:51 +02:00 committed by Daniel Kraft
parent befdf74172
commit c3005b0f0c
25 changed files with 589 additions and 92 deletions

View file

@ -1,3 +1,46 @@
2008-07-24 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-24 Daniel Kraft <d@domob.eu>
* match.c (gfc_match): Add assertion to catch wrong calls trying to

View file

@ -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;
}

View file

@ -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;

View file

@ -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 warn_array_temp;
int max_errors;
@ -1915,7 +1917,6 @@ typedef struct
int warn_std;
int allow_std;
int warn_nonstd_intrinsics;
int fshort_enums;
int convert;
int record_marker;
@ -2255,7 +2256,7 @@ try gfc_convert_type_warn (gfc_expr *, gfc_typespec *, int, int);
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 *);
@ -2263,6 +2264,10 @@ gfc_intrinsic_sym *gfc_find_subroutine (const char *);
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 *);

View file

@ -807,15 +807,47 @@ gfc_intrinsic_actual_ok (const char *name, const bool subroutine_flag)
}
/* 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. */
int
gfc_intrinsic_name (const char *name, int subroutine_flag)
bool
gfc_is_intrinsic (gfc_symbol* sym, int subroutine_flag, locus loc)
{
return subroutine_flag ? gfc_find_subroutine (name) != NULL
: gfc_find_function (name) != NULL;
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;
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 *specific, gfc_expr *expr, int error_flag)
/* 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 *expr, int error_flag)
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, int error_flag)
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, gfc_typespec *ts)
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);
}

View file

@ -138,8 +138,8 @@ and warnings}.
@gccoptlist{-fmax-errors=@var{n} @gol
-fsyntax-only -pedantic -pedantic-errors @gol
-Wall -Waliasing -Wampersand -Warray-bounds -Wcharacter-truncation @gol
-Wconversion -Wimplicit-interface -Wline-truncation -Wnonstd-intrinsics @gol
-Wsurprising -Wno-tabs -Wunderflow -Wunused-parameter}
-Wconversion -Wimplicit-interface -Wline-truncation -Wintrinsics-std @gol
-Wsurprising -Wno-tabs -Wunderflow -Wunused-parameter -Wintrinsics-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}
@ -728,11 +730,15 @@ Warn if a procedure is called without an explicit interface.
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}
@ -772,6 +778,15 @@ is active for @option{-pedantic}, @option{-std=f95}, @option{-std=f2003},
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

View file

@ -96,9 +96,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
@ -116,6 +116,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

View file

@ -76,6 +76,8 @@ gfc_init_options (unsigned int argc, const char **argv)
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;
@ -124,8 +126,6 @@ gfc_init_options (unsigned int argc, const char **argv)
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 ();
@ -355,9 +355,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 ();
@ -379,10 +376,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);
@ -522,6 +520,10 @@ gfc_handle_option (size_t scode, const char *arg, int value)
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;
@ -783,8 +785,8 @@ gfc_handle_option (size_t scode, const char *arg, int value)
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:

View file

@ -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;

View file

@ -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;
}
}

View file

@ -1,3 +1,22 @@
2008-07-24 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.
2008-07-24 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/29952

View file

@ -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

View file

@ -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>

View file

@ -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

View file

@ -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" } }

View file

@ -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" } }

View file

@ -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" } }

View file

@ -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" } }

View file

@ -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

View file

@ -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

View file

@ -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" }

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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 ")