+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
/* 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))
}
+/* 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
sym->result = result;
}
+ /* Warn if this procedure has the same name as an intrinsic. */
+ warn_intrinsic_shadow (sym, true);
+
return MATCH_YES;
}
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;
}
{
match m;
try t;
- gfc_intrinsic_sym *isym;
if (e == NULL)
return SUCCESS;
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",
/* 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;
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;
int warn_std;
int allow_std;
- int warn_nonstd_intrinsics;
int fshort_enums;
int convert;
int record_marker;
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 *);
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 *);
}
-/* 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;
}
/* 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;
}
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
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);
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);
+}
@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}.
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
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}
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}
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
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
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
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;
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 ();
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 ();
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);
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;
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:
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;
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)
/* 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);
/* 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;
{
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;
}
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);
/* 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;
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;
}
}
+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
! { 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
! { 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>
! 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)
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
--- /dev/null
+! { 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" } }
--- /dev/null
+! { 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" } }
--- /dev/null
+! { 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" } }
--- /dev/null
+! { 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" } }
--- /dev/null
+! { 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
--- /dev/null
+! { 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
--- /dev/null
+! { 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" }
! { 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
! { 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
! { 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
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
! { 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
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 ")
projects / gcc.git / commitdiff