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:
parent
befdf74172
commit
c3005b0f0c
25 changed files with 589 additions and 92 deletions
|
@ -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
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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 *);
|
||||
|
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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;
|
||||
|
|
|
@ -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;
|
||||
}
|
||||
}
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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>
|
||||
|
|
|
@ -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
|
||||
|
|
57
gcc/testsuite/gfortran.dg/intrinsic_shadow_1.f03
Normal file
57
gcc/testsuite/gfortran.dg/intrinsic_shadow_1.f03
Normal 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" } }
|
29
gcc/testsuite/gfortran.dg/intrinsic_shadow_2.f03
Normal file
29
gcc/testsuite/gfortran.dg/intrinsic_shadow_2.f03
Normal 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" } }
|
27
gcc/testsuite/gfortran.dg/intrinsic_shadow_3.f03
Normal file
27
gcc/testsuite/gfortran.dg/intrinsic_shadow_3.f03
Normal 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" } }
|
48
gcc/testsuite/gfortran.dg/intrinsic_std_1.f90
Normal file
48
gcc/testsuite/gfortran.dg/intrinsic_std_1.f90
Normal 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" } }
|
15
gcc/testsuite/gfortran.dg/intrinsic_std_2.f90
Normal file
15
gcc/testsuite/gfortran.dg/intrinsic_std_2.f90
Normal 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
|
15
gcc/testsuite/gfortran.dg/intrinsic_std_3.f90
Normal file
15
gcc/testsuite/gfortran.dg/intrinsic_std_3.f90
Normal 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
|
46
gcc/testsuite/gfortran.dg/intrinsic_std_4.f90
Normal file
46
gcc/testsuite/gfortran.dg/intrinsic_std_4.f90
Normal 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" }
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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 ")
|
||||
|
|
Loading…
Add table
Reference in a new issue