Hello world,
like it says in the ChangeLog below. There is a chance that this
may still generate some false positives. I tried to follow
Fortran terminology in the error messages, at least.
Regression-tested. Did I miss anything? OK for trunk?
Best regards
Thomas
Implement warnings based on variable definition and use.
This patch grew from trying to implement PR 30438 into something bigger.
This now warns about variables which were never defined, but are used
via a new option -Wundefined-vars and implements
-Wunused-but-set-variable for Fortran.
It works by keeping tabls of several things in the attributes of a
variable: If and how it has been set (via value_set), used (via
value_used), if it has been allocated (via allocated) and if a
warning has already been emitted for the symbol. This looks at
statements in a namespace only; control flow is *not* considered.
In every corner of the compiler that I could find where values are
set or used, flags are set accodingly. Updates are done if the new
use is considered to be more "important" than the old one. The
location of use or definition is also recorded, as is the place
where a variable may be allocated.
After all the flags have been correctly set (one at least hopes)
gfc_resolve then calls warn_unused_vs_set, which then iterates
over the symbols, calling find_unused_vs_set where all warnings
are emitted. I tried to be conservative here to avoid false
positives, so a whole lot of conditions are excluded (see the top
of the function).
I thought a bit on where to put -Wunused-read and -Wunused-intent-out.
While reading in a value and then not using it, or getting it from an
INTENT(OUT) argument may be dubious, people could use it for skipping
over unneeded data or because an API requires it. Hence, I feld that -Wall
would be too harsh, but I am open to discussion here.
The warn_undefined_vars_* tests are split because the testsuite would
not find warnings in certain lines even though they were issued and
I tried out ! { dg-warning ".+" } . I suspect some strangeness/bug
in gfortran.dg, but did not investigate further.
gcc/fortran/ChangeLog:
PR fortran/30438
PR fortran/28004
* dump-parse-tree.cc (gfc_debug_code_node): New function.
(show_attr): Add select_rank_temporary. Fix typo. Add referenced,
value_set, allocated and value_used.
* gfortran.h (enum value_set): New enum.
(enum value_used): New enum.
(gfc_symbol): Add value_set, value_used, allocated and
warning_emitted attributes. Rename formal_at to other_loc.
Add extra_loc.
(gfc_value_set_at): Add prototype.
(gfc_lvalue_allocated_at): Likewise.
(gfc_mark_lhs_as_used): Likewise.
(gfc_value_used_expr): Likewise.
(gfc_value_set_and_used): Likewise.
(gfc_used_in_allocate_expr): Likewise.
* interface.cc (gfc_compare_actual_formal): Mark actual arguments
according to INTENT and VALUE on formal arguments.
(gfc_procedure_use): Add VALUE_ARG/VALUE_MAYBE_USED for
implicit arguments.
* intrinsic.cc (mark_args_as_used): New function.
(init_arglist): Adjust comment.
(gfc_intrinsic_sub_interface): Use mark_args_as_used.
* invoke.texi: Document -Wundefined-vars, -Wunused-intent-out and
-Wunused-read.
* io.cc (resolve_tag_format): Mark expressions as used.
(resolve_tag): Mark as used or set, depending on tag.
(gfc_resolve_dt): Mark internal unit as set.
(gfc_resolve_inquire): Mark value as set for INQUIRE_RESOLVE_TAG macro.
* lang.opt: Add -Wundefined-vars, -Wunused-intent-out and -Wunused-read.
* lang.opt.urls: Regenerated.
* resolve.cc (resolve_function): Replace formal_at by other_loc.
(resolve_call): Likewise.
(gfc_resolve_iterator): Mark iterator variable as set and used and
other expressions as used.
(resolve_forall_iterators): Likewise.
(resolve_allocate_expr): On success, call gfc_used_in_allocate_expr
and mark value as set if source is present.
(resolve_transfer): Mark set/read according to context.
(gfc_resolve_blocks): Mark expr1 and expr2 as used.
(mark_lhs_assignments_set): Prototype / new function.
(gfc_resolve_code): Mark expr2, expr3 and expr4 as used.
(var_value_is_used): New function.
(var_value_is_set): New function.
(find_unused_vs_set): New function.
(warn_unused_vs_set): New function.
(gfc_resolve): Call warn_unused_vs_set.
* symbol.cc (gfc_value_set_at): New function.
(mark_vars_as_used): New function.
(gfc_value_used_expr): New function.
(gfc_value_set_and_used): New function.
(gfc_used_in_allocate_expr): new function.
(gfc_lvalue_allocated_at): New function.
* trans-decl.cc (gfc_finish_var_decl): If we already emitted a warning,
suppress further middle-end warning o that variable.
libgfortran/ChangeLog:
PR fortran/30438
PR fortran/28004
* mk-kinds-h.sh: Add print statement so test will compile with -Wall
-Werror.
* mk-sik-inc.sh: Likewise.
* mk-srk-inc.sh: Likewise.
libgomp/ChangeLog:
PR fortran/30438
PR fortran/28004
* testsuite/libgomp.fortran/alloc-1.F90: Shut up
-Wunused-but-set-variable.
* testsuite/libgomp.fortran/alloc-12.f90: Likewise.
gcc/testsuite/ChangeLog:
PR fortran/30438
PR fortran/28004
* gfortran.dg/allocatable_length.f90: Add -Wno-undefined-vars.
* gfortran.dg/allocatable_scalar_6.f90: Likewise.
* gfortran.dg/allocatable_uninitialized_1.f90: Add
-Wno-unused-but-set-variable
-Wno-undefined-vars.
* gfortran.dg/assignment_4.f90: Add -Wno-undefined-vars.
* gfortran.dg/attr_deprecated-2.f90: Likewise.
* gfortran.dg/c_by_val_5.f90: Add -Wno-unused-but-set-variable.
* gfortran.dg/char_component_initializer_2.f90: Shut up warning.
* gfortran.dg/char_length_1.f90: Add statement to shut up warning.
* gfortran.dg/constructor_9.f90: Add -Wno-unused-but-set-variable.
* gfortran.dg/gamma_2.f90: Add statement to shut up warning.
* gfortran.dg/gomp/allocate-10.f90: Add -Wno-unused-but-set-variable.
* gfortran.dg/io_constraints_8.f90: Likewise.
* gfortran.dg/label_5.f90: Likewise.
* gfortran.dg/len_trim.f90: Likewise.
* gfortran.dg/linefile.f90: Likewise.
* gfortran.dg/pointer_check_13.f90: Add dg-warning.
* gfortran.dg/pr102366.f90: Add -Wno-unused-but-set-variable.
* gfortran.dg/pr103475.f90: Likewise.
* gfortran.dg/pr91497.f90: Likewise.
* gfortran.dg/pr91497_2.f90: Likewise.
* gfortran.dg/pr96312.f90: Likewise.
* gfortran.dg/pr98411.f90: Likewise.
* gfortran.dg/transfer_check_4.f90: Likewise.
* gfortran.dg/warnings_are_errors_1.f90: Add print statement.
* gfortran.dg/warn_undefined_vars_1.f90: New test.
* gfortran.dg/warn_undefined_vars_2.f90: New test.
* gfortran.dg/warn_undefined_vars_3.f90: New test.
* gfortran.dg/warn_undefined_vars_4.f90: New test.
* gfortran.dg/warn_unused_intent_out_1.f90: New test.
* gfortran.dg/warn_unused_read_1.f90: New test.
diff --git a/gcc/fortran/dump-parse-tree.cc b/gcc/fortran/dump-parse-tree.cc
index ea878099da5..ba2b331d7b1 100644
--- a/gcc/fortran/dump-parse-tree.cc
+++ b/gcc/fortran/dump-parse-tree.cc
@@ -163,6 +163,16 @@ gfc_debug_code (gfc_code *c)
dumpfile = tmp;
}
+DEBUG_FUNCTION void
+gfc_debug_code_node (gfc_code *c)
+{
+ FILE *tmp = dumpfile;
+ dumpfile = stderr;
+ show_code_node (1, c);
+ fputc ('\n', dumpfile);
+ dumpfile = tmp;
+}
+
DEBUG_FUNCTION void
debug (gfc_symbol *sym)
{
@@ -930,6 +940,8 @@ show_attr (symbol_attribute *attr, const char * module)
fputs (" CAF-TOKEN", dumpfile);
if (attr->select_type_temporary)
fputs (" SELECT-TYPE-TEMPORARY", dumpfile);
+ if (attr->select_rank_temporary)
+ fputs (" SELECT-RANK-TEMPORARY", dumpfile);
if (attr->associate_var)
fputs (" ASSOCIATE-VAR", dumpfile);
if (attr->pdt_kind)
@@ -1004,7 +1016,7 @@ show_attr (symbol_attribute *attr, const char * module)
if (attr->recursive)
fputs (" RECURSIVE", dumpfile);
if (attr->unmaskable)
- fputs (" UNMASKABKE", dumpfile);
+ fputs (" UNMASKABLE", dumpfile);
if (attr->masked)
fputs (" MASKED", dumpfile);
if (attr->contained)
@@ -1023,6 +1035,52 @@ show_attr (symbol_attribute *attr, const char * module)
fputs (" ALWAYS-EXPLICIT", dumpfile);
if (attr->is_main_program)
fputs (" IS-MAIN-PROGRAM", dumpfile);
+ if (attr->referenced)
+ fputs (" REFERENCED", dumpfile);
+
+ switch (attr->value_set)
+ {
+ case VALUE_UNSET:
+ break;
+ case VALUE_ARG:
+ fputs (" VALUE-SET(ARG)", dumpfile);
+ break;
+ case VALUE_INTENT_OUT:
+ fputs (" VALUE-SET(INTENT-OUT)", dumpfile);
+ break;
+ case VALUE_READ:
+ fputs (" VALUE-SET(READ)", dumpfile);
+ break;
+ case VALUE_VARDEF:
+ fputs (" VALUE-SET(VARDEF)", dumpfile);
+ break;
+ default:
+ gfc_internal_error ("Wrong value for value_set");
+ }
+
+ if (attr->allocated)
+ fputs (" ALLOCATED", dumpfile);
+
+ switch (attr->value_used)
+ {
+ case VALUE_UNUSED:
+ break;
+ case VALUE_MAYBE_USED:
+ fputs (" VALUE-USED(MAYBE-USED)", dumpfile);
+ break;
+ case VALUE_USED:
+ fputs (" VALUE-USED(USED)", dumpfile);
+ break;
+ case VALUE_INTENT_IN:
+ fputs (" VALUE-USED(INTENT-IN)", dumpfile);
+ break;
+ case VALUE_VALUE_ARG:
+ fputs (" VALUE-USED(VALUE-ARG)", dumpfile);
+ break;
+ default:
+ gfc_internal_error ("Wrong value for value_used");
+ }
+
if (attr->oacc_routine_nohost)
fputs (" OACC-ROUTINE-NOHOST", dumpfile);
if (attr->temporary)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 6c45e9b1682..01c88c78a06 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -401,6 +401,26 @@ enum oacc_routine_lop
OACC_ROUTINE_LOP_ERROR
};
+/* How a variable gets its value. Ordering is significant. */
+
+enum value_set
+{ VALUE_UNSET = 0,
+ VALUE_INTENT_OUT,
+ VALUE_ARG,
+ VALUE_READ,
+ VALUE_VARDEF
+};
+
+/* How a variable's value is used. */
+enum value_used
+{
+ VALUE_UNUSED = 0,
+ VALUE_MAYBE_USED,
+ VALUE_INTENT_IN,
+ VALUE_VALUE_ARG,
+ VALUE_USED
+};
+
/* Strings for all symbol attributes. We use these for dumping the
parse tree, in error messages, and also when reading and writing
modules. In symbol.cc. */
@@ -1003,6 +1023,19 @@ typedef struct
modification of type or type parameters is permitted. */
unsigned referenced:1;
+ /* Set if the value of the symbol has been assigned one way or another. */
+ ENUM_BITFIELD (value_set) value_set:3;
+
+ /* Set if the value of the symbol has been used. */
+ ENUM_BITFIELD (value_used) value_used:3;
+
+ /* Set if the symbol has been allocated in the current procedure. */
+ unsigned allocated:1;
+
+ /* Set if we already emitted a warning for this symbol and the
+ middle-end should not add additional ones. */
+ unsigned warning_emitted:1;
+
/* Set if this is the symbol for the main program. */
unsigned is_main_program:1;
@@ -2151,9 +2184,12 @@ typedef struct gfc_symbol
/* Link to next entry in derived type list */
struct gfc_symbol *dt_next;
- /* This is for determining where the symbol has been used first, for better
- location of error messages. */
- locus formal_at;
+ /* For when we would like an additional location in an error message. */
+ locus other_loc;
+
+ /* For when we would like even one more location. Currently used to store
+ where a variable is allocated. */
+ locus extra_loc;
}
gfc_symbol;
@@ -3956,6 +3992,17 @@ void gfc_warn_intrinsic_shadow (const gfc_symbol*, bool, bool);
bool gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**,
bool, locus);
+bool gfc_value_set_at (gfc_symbol *, locus *loc = NULL,
+ enum value_set = VALUE_VARDEF);
+
+bool gfc_lvalue_allocated_at (gfc_symbol *, locus *);
+void gfc_mark_lhs_as_used (gfc_expr *, locus *);
+
+void gfc_value_used_expr (gfc_expr *, enum value_used);
+void gfc_value_set_and_used (gfc_expr *, locus *loc,
+ enum value_set, enum value_used);
+void gfc_used_in_allocate_expr (gfc_expr *, locus *loc);
+
/* match.cc -- FIXME */
void gfc_free_iterator (gfc_iterator *, int);
void gfc_free_forall_iterator (gfc_forall_iterator *);
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 8ab2fade283..ed898506d0e 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -4052,7 +4052,6 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
goto match;
}
}
-
/* F2023: 15.5.2.5 Ordinary dummy variables:
"(21) If the procedure is nonelemental, the dummy argument does not
have the VALUE attribute, and the actual argument is an array section
@@ -4225,6 +4224,42 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
if (*ap == NULL && n > 0)
*ap = new_arg[0];
+ if (!in_statement_function)
+ for (f = formal, i = 0; f; f = f->next, i++)
+ {
+ if (new_arg[i]->expr)
+ {
+ gfc_expr *e = new_arg[i]->expr;
+
+ if (f->sym->attr.value)
+ {
+ gfc_value_used_expr (e, VALUE_VALUE_ARG);
+ continue;
+ }
+ switch (f->sym->attr.intent)
+ {
+ case INTENT_OUT:
+ {
+ gfc_symbol *s = e->symtree->n.sym;
+ gfc_value_set_at (s, &e->where, VALUE_INTENT_OUT);
+
+ /* INTENT(OUT) allocates variables as far as we know. */
+ if (s->attr.allocatable)
+ s->attr.allocated = 1;
+ }
+ break;
+ case INTENT_IN:
+ gfc_value_used_expr (e, VALUE_INTENT_IN);
+ break;
+ case INTENT_INOUT:
+ case INTENT_UNKNOWN:
+ gfc_value_set_and_used (e, &e->where, VALUE_ARG,
+ VALUE_MAYBE_USED);
+ break;
+ }
+ }
+ }
+
return true;
}
@@ -4648,6 +4683,11 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
}
}
+ if (implicit)
+ for (a = *ap; a; a = a->next)
+ gfc_value_set_and_used (a->expr, &a->expr->where, VALUE_ARG,
+ VALUE_MAYBE_USED);
+
return true;
}
diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index 6ffd7237468..969f5368f3a 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -4959,11 +4959,52 @@ finish:
return true;
}
+/* Mark actual arguments as used according to the INTENTs of a
+ formal arglist. */
-/* Initialize the gfc_current_intrinsic_arg[] array for the benefit of
- error messages. This subroutine returns false if a subroutine
- has more than MAX_INTRINSIC_ARGS, in which case the actual argument
- list cannot match any intrinsic. */
+static void
+mark_args_as_used (gfc_intrinsic_arg *f, gfc_actual_arglist *a)
+{
+ while (f != NULL && a != NULL)
+ {
+ if (a->expr != NULL)
+ {
+ if (f->value)
+ {
+ gfc_value_used_expr (a->expr, VALUE_VALUE_ARG);
+ continue;
+ }
+
+ switch (f->intent)
+ {
+ case INTENT_INOUT:
+ case INTENT_UNKNOWN:
+ gfc_value_set_and_used (a->expr, &a->expr->where, VALUE_ARG,
+ VALUE_MAYBE_USED);
+ break;
+
+ case INTENT_IN:
+ gfc_value_used_expr (a->expr, VALUE_INTENT_IN);
+ break;
+
+ case INTENT_OUT:
+ if (a->expr->expr_type == EXPR_VARIABLE)
+ {
+ gfc_symbol *s = a->expr->symtree->n.sym;
+ gfc_value_set_at (s, &a->expr->where, VALUE_INTENT_OUT);
+ if (s->attr.allocatable)
+ s->attr.allocated = 1;
+ }
+ break;
+ }
+ }
+ f = f->next;
+ a = a->next;
+ }
+}
+
+/* Initialize the gfc_current_intrinsic_arg[] array for the benefit of error
+ messages. Errors out if there are too many arguments. */
static void
init_arglist (gfc_intrinsic_sym *isym)
@@ -5424,6 +5465,7 @@ gfc_intrinsic_sub_interface (gfc_code *c, int error_flag)
c->resolved_sym->attr.noreturn = isym->noreturn;
+ mark_args_as_used (isym->formal, c->ext.actual);
return MATCH_YES;
fail:
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 00fbc49c937..a52c03f9dc0 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -155,7 +155,8 @@ and warnings}.
-Wuse-without-only -Wintrinsics-std -Wline-truncation -Wno-align-commons
-Wno-overwrite-recursive -Wno-tabs -Wreal-q-constant -Wsurprising
-Wunderflow -Wunused-parameter -Wrealloc-lhs -Wrealloc-lhs-all
--Wfrontend-loop-interchange -Wtarget-lifetime -fmax-errors=@var{n}
+-Wfrontend-loop-interchange -Wtarget-lifetime -Wundefined-vars
+-Wunused-intent-out -Wunused-read -fmax-errors=@var{n}
-fsyntax-only -pedantic
-pedantic-errors
}
@@ -996,8 +997,8 @@ This currently includes @option{-Waliasing}, @option{-Wampersand},
@option{-Wconversion}, @option{-Wsurprising}, @option{-Wc-binding-type},
@option{-Wintrinsics-std}, @option{-Wtabs}, @option{-Wintrinsic-shadow},
@option{-Wline-truncation}, @option{-Wtarget-lifetime},
-@option{-Winteger-division}, @option{-Wreal-q-constant}, @option{-Wunused}
-and @option{-Wundefined-do-loop}.
+@option{-Winteger-division}, @option{-Wreal-q-constant}, @option{-Wunused},
+@option{-Wundefined-do-loop} and @option{-Wundefined-vars}.
@opindex Waliasing
@cindex aliasing
@@ -1096,7 +1097,8 @@ by @option{-Wall}.
@item -Wextra
Enables some warning options for usages of language features that
may be problematic. This currently includes @option{-Wcompare-reals},
-@option{-Wunused-parameter} and @option{-Wdo-subscript}.
+@option{-Wunused-parameter}, @option{-Wdo-subscript},
+@option{-Wunused-intent-out} and @option{-Wunused-read}.
@opindex Wfrontend-loop-interchange
@cindex warnings, loop interchange
@@ -1208,6 +1210,13 @@ or an overflow
during iteration of an induction variable of the loop.
This option is implied by @option{-Wall}.
+@opindex Wundefined-vars
+@cindex warnings, undefined variables
+@item -Wundefined-vars
+Warn if variables are found to be used that cannot be defined (have a
+value assigned to them). This also includes using allocatable
+variables that are not allocated.
+
@opindex Wunderflow
@cindex warnings, underflow
@cindex underflow
@@ -1250,6 +1259,45 @@ but about unused @code{PARAMETER} values. @option{-Wunused-parameter}
is implied by @option{-Wextra} if also @option{-Wunused} or
@option{-Wall} is used.
+@opindex Wunused-intent-out
+@cindex warnings, unused INTENT(OUT) argument
+@cindex unused INTENT(OUT) argument
+@item -Wunused-intent-out
+Warn about variables passed to @code{INTENT(OUT)} arguments whose
+values are then unused. This option is implied by @option{-Wextra}.
+The following code shows an example where this warning will be
+emitted:
+
+@smallexample
+module y
+ implicit none
+contains
+ subroutine bar
+ real :: a
+ call foo(a) ! Warning will be emitted here
+ end subroutine bar
+ subroutine foo(x)
+ real, intent(out) :: x
+ x = 0.4
+ end subroutine foo
+end module y
+@end smallexample
+
+@opindex Wunused-read
+@cindex warnings, unused read
+@cindex unused read warnings
+@item -Wunused-read
+Warn about variables in @code{READ} statements whose values are
+never used. This warning is implied by @option{-Wextra}.
+The following code shows an example where this warning will be
+emitted:
+@smallexample
+program main
+ real :: x
+ read (*,*) x
+end program main
+@end smallexample
+
@opindex Walign-commons
@cindex warnings, alignment of @code{COMMON} blocks
@cindex alignment of @code{COMMON} blocks
diff --git a/gcc/fortran/io.cc b/gcc/fortran/io.cc
index 16d54871611..85ff06fbda0 100644
--- a/gcc/fortran/io.cc
+++ b/gcc/fortran/io.cc
@@ -1795,6 +1795,7 @@ resolve_tag_format (gfc_expr *e)
return false;
}
+ gfc_value_used_expr (e, VALUE_USED);
return true;
}
@@ -1835,6 +1836,7 @@ resolve_tag_format (gfc_expr *e)
}
}
+ gfc_value_used_expr (e, VALUE_USED);
return true;
}
@@ -1904,6 +1906,12 @@ resolve_tag (const io_tag *tag, gfc_expr *e)
return false;
}
+ if (tag == &tag_convert)
+ {
+ if (!gfc_notify_std (GFC_STD_GNU, "CONVERT tag at %L", &e->where))
+ return false;
+ }
+
/* NEWUNIT, IOSTAT, SIZE and IOMSG are variable definition contexts. */
if (tag == &tag_newunit || tag == &tag_iostat
|| tag == &tag_size || tag == &tag_iomsg)
@@ -1913,13 +1921,11 @@ resolve_tag (const io_tag *tag, gfc_expr *e)
sprintf (context, _("%s tag"), tag->name);
if (!gfc_check_vardef_context (e, false, false, false, context))
return false;
- }
- if (tag == &tag_convert)
- {
- if (!gfc_notify_std (GFC_STD_GNU, "CONVERT tag at %L", &e->where))
- return false;
+ gfc_value_set_at (e->symtree->n.sym, &e->where, VALUE_VARDEF);
}
+ else
+ gfc_value_used_expr (e, VALUE_USED);
return true;
}
@@ -3300,6 +3306,7 @@ gfc_resolve_dt (gfc_code *dt_code, gfc_dt *dt, locus *loc)
{
gfc_expr *e;
io_kind k;
+ bool internal_unit;
/* This is set in any case. */
gcc_assert (dt->dt_io_kind);
@@ -3348,6 +3355,7 @@ gfc_resolve_dt (gfc_code *dt_code, gfc_dt *dt, locus *loc)
return false;
}
+ internal_unit = false;
if (gfc_resolve_expr (e)
&& (e->ts.type != BT_INTEGER
&& (e->ts.type != BT_CHARACTER || e->expr_type != EXPR_VARIABLE)))
@@ -3387,6 +3395,7 @@ gfc_resolve_dt (gfc_code *dt_code, gfc_dt *dt, locus *loc)
if (e->ts.type == BT_CHARACTER)
{
+ internal_unit = true;
if (gfc_has_vector_index (e))
{
gfc_error ("Internal unit with vector subscript at %L", &e->where);
@@ -3395,10 +3404,14 @@ gfc_resolve_dt (gfc_code *dt_code, gfc_dt *dt, locus *loc)
/* If we are writing, make sure the internal unit can be changed. */
gcc_assert (k != M_PRINT);
- if (k == M_WRITE
- && !gfc_check_vardef_context (e, false, false, false,
+ if (k == M_WRITE)
+ {
+ if (!gfc_check_vardef_context (e, false, false, false,
_("internal unit in WRITE")))
- return false;
+ return false;
+
+ gfc_value_set_at (e->symtree->n.sym, &e->where);
+ }
}
if (e->rank && e->ts.type != BT_CHARACTER)
@@ -3415,6 +3428,9 @@ gfc_resolve_dt (gfc_code *dt_code, gfc_dt *dt, locus *loc)
return false;
}
+ if (!internal_unit)
+ gfc_value_used_expr (e, VALUE_USED);
+
/* If we are reading and have a namelist, check that all namelist symbols
can appear in a variable definition context. */
if (dt->namelist)
@@ -3439,6 +3455,7 @@ gfc_resolve_dt (gfc_code *dt_code, gfc_dt *dt, locus *loc)
dt->namelist->name, loc, n->sym->name);
return false;
}
+ gfc_value_set_at (n->sym, NULL);
}
t = dtio_procs_present (n->sym, k);
@@ -4776,6 +4793,7 @@ gfc_resolve_inquire (gfc_inquire *inquire)
if (gfc_check_vardef_context ((expr), false, false, false, \
context) == false) \
return false; \
+ gfc_value_set_at (expr->symtree->n.sym, &expr->where); \
}
INQUIRE_RESOLVE_TAG (&tag_iomsg, inquire->iomsg);
INQUIRE_RESOLVE_TAG (&tag_iostat, inquire->iostat);
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index cbd13aa2019..8717eb17eb4 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -345,6 +345,10 @@ Wundefined-do-loop
Fortran Warning Var(warn_undefined_do_loop) LangEnabledBy(Fortran,Wall)
Warn about an invalid DO loop.
+Wundefined-vars
+Fortran Warning Var(warn_undefined_vars) LangEnabledBy(Fortran,Wall)
+Warn about variables which are not defined but referenced.
+
Wunderflow
Fortran Warning Var(warn_underflow) Init(1)
Warn about underflow of numerical constant expressions.
@@ -365,6 +369,14 @@ Wunused-dummy-argument
Fortran Warning Var(warn_unused_dummy_argument) LangEnabledBy(Fortran,Wall)
Warn about unused dummy arguments.
+Wunused-intent-out
+Fortran Warning Var(warn_unused_intent_out) LangEnabledBy(Fortran,Wextra)
+Warn about INTENT(OUT) arguments whose values are not used.
+
+Wunused-read
+Fortran Warning Var(warn_unused_read) LangEnabledBy(Fortran,Wextra)
+Warn about variables read in whose values are not used.
+
Wzerotrip
Fortran Warning Var(warn_zerotrip) LangEnabledBy(Fortran,Wall)
Warn about zero-trip DO loops.
diff --git a/gcc/fortran/lang.opt.urls b/gcc/fortran/lang.opt.urls
index d401ac826da..9ad68752066 100644
--- a/gcc/fortran/lang.opt.urls
+++ b/gcc/fortran/lang.opt.urls
@@ -255,6 +255,9 @@ LangUrlSuffix_Fortran(gfortran/Error-and-Warning-Options.html#index-Wtabs)
Wundefined-do-loop
LangUrlSuffix_Fortran(gfortran/Error-and-Warning-Options.html#index-Wundefined-do-loop)
+Wundefined-vars
+LangUrlSuffix_Fortran(gfortran/Error-and-Warning-Options.html#index-Wundefined-vars)
+
Wunderflow
LangUrlSuffix_Fortran(gfortran/Error-and-Warning-Options.html#index-Wunderflow)
@@ -270,6 +273,12 @@ UrlSuffix(gcc/Warning-Options.html#index-Wno-unused)
Wunused-dummy-argument
LangUrlSuffix_Fortran(gfortran/Error-and-Warning-Options.html#index-Wunused-dummy-argument)
+Wunused-intent-out
+LangUrlSuffix_Fortran(gfortran/Error-and-Warning-Options.html#index-Wunused-intent-out)
+
+Wunused-read
+LangUrlSuffix_Fortran(gfortran/Error-and-Warning-Options.html#index-Wunused-read)
+
Wzerotrip
LangUrlSuffix_Fortran(gfortran/Error-and-Warning-Options.html#index-Wzerotrip)
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index 19a7a2b3378..74cafd30149 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -3524,13 +3524,13 @@ resolve_function (gfc_expr *expr)
gfc_warning (OPT_Wexternal_argument_mismatch,
"Different argument lists in external dummy "
"function %s at %L and %L", sym->name,
- &expr->where, &sym->formal_at);
+ &expr->where, &sym->other_loc);
}
}
else if (!sym->formal_resolved)
{
gfc_get_formal_from_actual_arglist (sym, expr->value.function.actual);
- sym->formal_at = expr->where;
+ sym->other_loc = expr->where;
}
}
/* See if function is already resolved. */
@@ -4301,13 +4301,13 @@ resolve_call (gfc_code *c)
gfc_warning (OPT_Wexternal_argument_mismatch,
"Different argument lists in external dummy "
"subroutine %s at %L and %L", csym->name,
- &c->loc, &csym->formal_at);
+ &c->loc, &csym->other_loc);
}
}
else if (!csym->formal_resolved)
{
gfc_get_formal_from_actual_arglist (csym, c->ext.actual);
- csym->formal_at = c->loc;
+ csym->other_loc = c->loc;
}
}
@@ -8506,6 +8506,12 @@ gfc_resolve_iterator (gfc_iterator *iter, bool real_ok, bool own_scope)
&iter->step->where);
}
+ gfc_value_set_and_used (iter->var, &iter->var->where, VALUE_VARDEF,
+ VALUE_USED);
+ gfc_value_used_expr (iter->start, VALUE_USED);
+ gfc_value_used_expr (iter->end, VALUE_USED);
+ gfc_value_used_expr (iter->step, VALUE_USED);
+
return true;
}
@@ -8939,6 +8945,12 @@ resolve_forall_iterators (gfc_forall_iterator *it)
}
if (iter->var->ts.kind != iter->stride->ts.kind)
gfc_convert_type (iter->stride, &iter->var->ts, 1);
+
+ gfc_value_set_and_used (iter->var, &iter->var->where, VALUE_VARDEF,
+ VALUE_USED);
+ gfc_value_used_expr (iter->start, VALUE_USED);
+ gfc_value_used_expr (iter->end, VALUE_USED);
+ gfc_value_used_expr (iter->stride, VALUE_USED);
}
for (iter = it; iter; iter = iter->next)
@@ -9730,6 +9742,11 @@ check_symbols:
}
success:
+ gfc_used_in_allocate_expr (e, &e->where);
+
+ if (code->expr3)
+ gfc_value_set_at (e->symtree->n.sym, &code->expr3->where);
+
return true;
failure:
@@ -11750,13 +11767,17 @@ resolve_transfer (gfc_code *code)
&& exp->expr_type != EXPR_STRUCTURE))
return;
- /* If we are reading, the variable will be changed. Note that
- code->ext.dt may be NULL if the TRANSFER is related to
- an INQUIRE statement -- but in this case, we are not reading, either. */
- if (dt && dt->dt_io_kind->value.iokind == M_READ
- && !gfc_check_vardef_context (exp, false, false, false,
- _("item in READ")))
- return;
+ if (dt && dt->dt_io_kind->value.iokind == M_READ)
+ {
+ /* If we are reading, the variable will be changed. Note that
+ code->ext.dt may be NULL if the TRANSFER is related to an INQUIRE
+ statement -- but in this case, we are not reading, either. */
+ if (!gfc_check_vardef_context (exp, false, false, false,
+ _("item in READ")))
+ return;
+
+ gfc_value_set_at (exp->symtree->n.sym, &exp->where, VALUE_READ);
+ }
const gfc_typespec *ts = exp->expr_type == EXPR_STRUCTURE
|| exp->expr_type == EXPR_FUNCTION
@@ -11871,6 +11892,11 @@ resolve_transfer (gfc_code *code)
"an assumed-size array", &code->loc);
return;
}
+
+ if (dt && (dt->dt_io_kind->value.iokind == M_WRITE
+ || dt->dt_io_kind->value.iokind == M_PRINT))
+ gfc_value_used_expr (exp, VALUE_USED);
+
}
@@ -13060,7 +13086,8 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns)
default:
gfc_internal_error ("gfc_resolve_blocks(): Bad block type");
}
-
+ gfc_value_used_expr (b->expr1, VALUE_USED);
+ gfc_value_used_expr (b->expr2, VALUE_USED);
gfc_resolve_code (b->next, ns);
}
}
@@ -14159,6 +14186,7 @@ deferred_op_assign (gfc_code **code, gfc_namespace *ns)
return true;
}
+static void mark_lhs_assignments_set (gfc_code *code);
/* Given a block of code, recursively resolve everything pointed to by this
code block. */
@@ -14170,6 +14198,7 @@ gfc_resolve_code (gfc_code *code, gfc_namespace *ns)
int forall_save, do_concurrent_save;
code_stack frame;
bool t;
+ gfc_code *orig_code = code;
frame.prev = cs_base;
frame.head = code;
@@ -14840,8 +14869,13 @@ start:
default:
gfc_internal_error ("gfc_resolve_code(): Bad statement code");
}
+ gfc_value_used_expr (code->expr2, VALUE_USED);
+ gfc_value_used_expr (code->expr3, VALUE_USED);
+ gfc_value_used_expr (code->expr4, VALUE_USED);
}
+ mark_lhs_assignments_set (orig_code);
+
cs_base = frame.prev;
}
@@ -20505,6 +20539,35 @@ gfc_resolve_uops (gfc_symtree *symtree)
check_uop_procedure (itr->sym, itr->sym->declared_at);
}
+/* Mark all lhs in assignment statement as used. It is better to put this into
+ its own function rather than into the different switch cases in
+ gfc_resolve_code. */
+
+static void
+mark_lhs_assignments_set (gfc_code *code)
+{
+
+ for (; code; code = code->next)
+ {
+ gfc_expr *lvalue = code->expr1, *rvalue = code->expr2;
+
+ if (lvalue == NULL || lvalue->symtree == NULL || rvalue == NULL)
+ continue;
+
+ switch (code->op)
+ {
+ case EXEC_ASSIGN:
+ if (gfc_is_reallocatable_lhs (lvalue) && lvalue->rank == rvalue->rank)
+ gfc_lvalue_allocated_at (lvalue->symtree->n.sym, &lvalue->where);
+
+ gcc_fallthrough();
+ case EXEC_POINTER_ASSIGN:
+ gfc_value_set_at (lvalue->symtree->n.sym, &rvalue->where);
+ default:
+ break;
+ }
+ }
+}
/* Examine all of the expressions associated with a program unit,
assign types to all intermediate expressions, make sure that all
@@ -20652,6 +20715,234 @@ resolve_codes (gfc_namespace *ns)
labels_obstack = old_obstack;
}
+/* Return true if the value of a variable can be considered used, either
+ through the value_used flag or because it is a suitable dummy argument. */
+
+static bool
+var_value_is_used (gfc_symbol *sym)
+{
+ if (sym->attr.value_used != VALUE_UNUSED)
+ return true;
+
+ if (!sym->attr.dummy)
+ return false;
+
+ if (sym->attr.value)
+ return false;
+
+ switch (sym->attr.intent)
+ {
+ case INTENT_UNKNOWN:
+ case INTENT_INOUT:
+ case INTENT_OUT:
+ return true;
+
+ case INTENT_IN:
+ default:
+ return false;
+ }
+}
+
+/* Similar, see if the variable could have gotten its value from somewhere. */
+
+static bool
+var_value_is_set (gfc_symbol *sym)
+{
+ if (sym->attr.value_set != VALUE_UNSET)
+ return true;
+
+ if (sym->value)
+ return true;
+
+ if (sym->ts.type == BT_DERIVED
+ && gfc_has_default_initializer (sym->ts.u.derived))
+ return true;
+
+ if (!sym->attr.dummy)
+ return false;
+
+ if (sym->attr.value)
+ return true;
+
+ if (sym->attr.intent == INTENT_OUT)
+ return false;
+
+ return true;
+}
+
+/* Callback function to catch set but never used variables. */
+
+static void
+find_unused_vs_set (gfc_symbol *sym)
+{
+ symbol_attribute *attr = &sym->attr;
+
+ if (attr->flavor != FL_VARIABLE)
+ return;
+
+ /* Do not warn about anything too far out of the ordinary. This might be
+ tightened later. */
+ if (attr->in_common || attr->in_equivalence || attr->artificial
+ || attr->cray_pointer || attr->cray_pointee || attr->associate_var
+ || attr->target || attr->fe_temp || attr->omp_declare_target
+ || attr->omp_declare_target_link || attr->omp_declare_target_local
+ || attr->omp_declare_target_indirect || attr->oacc_declare_create
+ || attr->oacc_declare_copyin || attr->oacc_declare_deviceptr
+ || attr->oacc_declare_device_resident || attr->oacc_declare_link
+ || attr->result || attr->warning_emitted || !attr->referenced)
+ return;
+
+ if (warn_unused_intent_out && attr->value_set == VALUE_INTENT_OUT
+ && !var_value_is_used (sym))
+ {
+ gfc_warning (OPT_Wunused_intent_out, "Variable %qs passed to "
+ "INTENT(OUT) argument at %L but value never used",
+ sym->name, &sym->other_loc);
+ attr->warning_emitted = 1;
+ return;
+ }
+
+ if (warn_unused_read && attr->value_set == VALUE_READ && !var_value_is_used (sym))
+ {
+ gfc_warning (OPT_Wunused_read, "Variable %qs read at %L but never "
+ "used", sym->name, &sym->other_loc);
+ attr->warning_emitted = 1;
+ return;
+ }
+
+ /* There is no allocation in sight, but the variable is used anyway. This
+ might be hidden behind PRESENT, but issue a warning nonetheless. If
+ people complain, we might want to make this to an extra option to be
+ included with -Wextra. */
+
+ if (warn_undefined_vars && attr->allocatable && !attr->allocated
+ && var_value_is_used (sym))
+ {
+ if (attr->dummy && attr->intent == INTENT_OUT)
+ {
+ gfc_warning (OPT_Wundefined_vars, "Unallocated INTENT(OUT) variable "
+ "%qs referenced at %L", sym->name, &sym->other_loc);
+ attr->warning_emitted = 1;
+ return;
+ }
+
+ if (!attr->dummy)
+ {
+ gfc_warning (OPT_Wundefined_vars, "Unallocated variable %qs "
+ "referenced at %L", sym->name, &sym->other_loc);
+ attr->warning_emitted = 1;
+ return;
+ }
+ }
+
+ if (warn_undefined_vars && !var_value_is_set (sym))
+ {
+ /* Warn about variables which have been allocated and used, but never
+ set. */
+ if (attr->allocated && sym->attr.value_used > VALUE_MAYBE_USED)
+ {
+ switch (sym->attr.value_used)
+ {
+ case VALUE_INTENT_IN:
+ gfc_warning (OPT_Wundefined_vars, "Allocated variable %qs passed "
+ "undefined to INTENT(IN) argument at %L", sym->name,
+ &sym->other_loc);
+ break;
+
+ case VALUE_VALUE_ARG:
+ gfc_warning (OPT_Wundefined_vars, "Allocated variable %qs passed "
+ "undefined to VALUE argument at %L", sym->name,
+ &sym->other_loc);
+ break;
+ case VALUE_USED:
+ gfc_warning (OPT_Wundefined_vars, "Allocated undefined variable "
+ "%qs used at %L", sym->name, &sym->other_loc);
+ break;
+ default:
+ gfc_internal_error ("Wrong value_set");
+ break;
+ }
+ attr->warning_emitted = 1;
+ return;
+ }
+
+ /* Similar, when undefined variables are passed to INTENT(IN), VALUE
+ arguments or are used in general. */
+
+ if (attr->value_used == VALUE_INTENT_IN)
+ {
+ gfc_warning (OPT_Wundefined_vars, "Undefined variable %qs passed "
+ "to INTENT(IN) argument at %L", sym->name, &sym->other_loc);
+ attr->warning_emitted = 1;
+ return;
+ }
+ else if (attr->value_used == VALUE_VALUE_ARG)
+ {
+ gfc_warning (OPT_Wundefined_vars, "Undefined variable %qs passed "
+ "to VALUE argument at %L", sym->name, &sym->other_loc);
+ attr->warning_emitted = 1;
+ return;
+ }
+ else if (attr->value_used == VALUE_USED)
+ {
+ if (attr->dummy && attr->intent == INTENT_OUT)
+ gfc_warning (OPT_Wundefined_vars, "Undefined INTENT(OUT) variable %qs "
+ "used at %L", sym->name, &sym->other_loc);
+ else
+ gfc_warning (OPT_Wundefined_vars, "Undefined variable %qs used at "
+ "%L", sym->name, &sym->other_loc);
+
+ attr->warning_emitted = 1;
+ return;
+ }
+
+ /* PR 28004 - warn about INTENT(OUT) variables that are never set. If
+ the variable or a component are allocatable, do not warn since this is
+ a frequent shortcut for deallocation. */
+
+ if (sym->attr.dummy && sym->attr.intent == INTENT_OUT
+ && !(attr->allocatable || attr->alloc_comp))
+ {
+ gfc_warning (OPT_Wundefined_vars, "INTENT(OUT) variable %qs "
+ "declared at %L is not assigned a value", sym->name,
+ &sym->declared_at);
+ attr->warning_emitted = 1;
+ return;
+ }
+ }
+
+ /* Warn for unused but defined variables. */
+
+ if (warn_unused_but_set_variable)
+ {
+ if (attr->value_set == VALUE_VARDEF && !var_value_is_used (sym))
+ {
+ gfc_warning (OPT_Wunused_but_set_variable_, "Variable %qs defined at "
+ "%L but never used", sym->name, &sym->other_loc);
+ attr->warning_emitted = 1;
+ return;
+ }
+ if (attr->allocatable && attr->allocated && !var_value_is_used (sym))
+ {
+ gfc_warning (OPT_Wunused_but_set_variable_, "Variable %qs "
+ "allocated at %L but never used", sym->name,
+ &sym->extra_loc);
+ attr->warning_emitted = 1;
+ return;
+ }
+ }
+}
+
+/* Run warn_unused_vs_set over a namespace recursively. */
+
+static void
+warn_unused_vs_set (gfc_namespace *ns)
+{
+ gfc_traverse_ns (ns, find_unused_vs_set);
+
+ for (gfc_namespace *n = ns->contained; n; n = n->sibling)
+ warn_unused_vs_set (n);
+}
/* This function is called after a complete program unit has been compiled.
Its purpose is to examine all of the expressions associated with a program
@@ -20683,6 +20974,10 @@ gfc_resolve (gfc_namespace *ns)
component_assignment_level = 0;
resolve_codes (ns);
+ if (warn_unused_but_set_variable || warn_unused_intent_out
+ || warn_unused_read || warn_undefined_vars)
+ warn_unused_vs_set (ns);
+
if (ns->omp_assumes)
gfc_resolve_omp_assumptions (ns->omp_assumes);
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 26e4b40d48e..8fda779df2a 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -5757,3 +5757,164 @@ gfc_find_symbol_by_name (const char *name, gfc_namespace *ns,
*result = found_sym;
return result != 0;
}
+
+/* Note that the value of a variable has been set to a "higher" value and, if
+ loc is passed, where. Return true of loc has been changed. */
+
+bool
+gfc_value_set_at (gfc_symbol *sym, locus *loc, enum value_set how)
+{
+ if (sym == NULL || sym->attr.flavor != FL_VARIABLE)
+ return false;
+
+ if (how <= sym->attr.value_set)
+ return false;
+
+ if (loc)
+ sym->other_loc = *loc;
+ else
+ memset (&sym->other_loc, 0, sizeof(*loc));
+
+ sym->attr.value_set = how;
+ return true;
+}
+
+/* Callback function for setting the "value_used" flag. We can also set
+ other_loc here because, in the event of an error message, at most one of
+ attr.value_used and attr.value_set can be true. */
+
+static int
+mark_vars_as_used (gfc_expr **e, int *walk_subtrees, void *data)
+{
+ gfc_expr *expr = *e;
+ gfc_symbol *sym;
+ enum value_used how_used = *(enum value_used *) data;
+
+ if (expr->expr_type != EXPR_VARIABLE && expr->expr_type != EXPR_FUNCTION)
+ return 0;
+
+ if (expr->symtree == NULL)
+ return 0;
+
+ /* Some intrinsic functions do not evaluate some (or all) of their
+ aguments. Do not walk the expressions there. */
+
+ if (expr->expr_type == EXPR_FUNCTION && expr->value.function.isym)
+ {
+ gfc_actual_arglist *a = expr->value.function.actual;
+
+ switch (expr->value.function.isym->id)
+ {
+ case GFC_ISYM_ALLOCATED:
+ case GFC_ISYM_EXTENDS_TYPE_OF:
+ case GFC_ISYM_SAME_TYPE_AS:
+ case GFC_ISYM_ASSOCIATED:
+ case GFC_ISYM_IS_CONTIGUOUS:
+ case GFC_ISYM_PRESENT:
+ case GFC_ISYM_RANK:
+ case GFC_ISYM_STORAGE_SIZE:
+ case GFC_ISYM_NULL:
+ *walk_subtrees = 0;
+ return 0;
+
+ case GFC_ISYM_LBOUND:
+ case GFC_ISYM_UBOUND:
+ case GFC_ISYM_SIZE:
+ gfc_expr_walker (&a->next->expr, mark_vars_as_used, &how_used);
+ *walk_subtrees = 0;
+ return 0;
+
+ case GFC_ISYM_TRANSFER:
+ /* Source. */
+ gfc_expr_walker (&a->expr, mark_vars_as_used, &how_used);
+ /* Size. */
+ gfc_expr_walker (&a->next->next->expr, mark_vars_as_used, &how_used);
+ *walk_subtrees = 0;
+ return 0;
+
+ case GFC_ISYM_OUT_OF_RANGE:
+ gfc_expr_walker (&a->next->expr, mark_vars_as_used, &how_used);
+ *walk_subtrees = 0;
+ return 0;
+
+ default:
+ break;
+ }
+ }
+
+ sym = expr->symtree->n.sym;
+
+ if (sym->attr.flavor != FL_VARIABLE)
+ return 0;
+
+ if (how_used <= sym->attr.value_used)
+ return 0;
+
+ sym->attr.value_used = how_used;
+ if (sym->other_loc.nextc == NULL)
+ sym->other_loc = expr->where;
+
+ return 0;
+}
+
+/* Recursively visit every variable and mark it as used. */
+
+void
+gfc_value_used_expr (gfc_expr *expr, enum value_used how_used)
+{
+
+ if (expr == NULL)
+ return;
+
+ gfc_expr_walker (&expr, mark_vars_as_used, &how_used);
+}
+
+/* For when we want to set everything in an expression as both
+ set and used, for example in an actual argument list. */
+
+void
+gfc_value_set_and_used (gfc_expr *expr, locus *loc, enum value_set how_set,
+ enum value_used how_used)
+{
+ if (!expr)
+ return;
+
+ if (expr->expr_type == EXPR_VARIABLE)
+ gfc_value_set_at (expr->symtree->n.sym, loc, how_set);
+
+ gfc_value_used_expr (expr, how_used);
+}
+
+/* ALLOCATE (A(N)) means that N is used, but A is not marked as such. */
+
+void
+gfc_used_in_allocate_expr (gfc_expr *expr, locus *loc)
+{
+ gfc_symbol *sym;
+ enum value_used prev_used;
+ locus prev_loc;
+
+ if (expr->expr_type != EXPR_VARIABLE)
+ return;
+
+ sym = expr->symtree->n.sym;
+ prev_used = sym->attr.value_used;
+ prev_loc = sym->other_loc;
+ gfc_value_used_expr (expr, VALUE_USED);
+ sym->attr.value_used = prev_used;
+ sym->other_loc = prev_loc;
+ sym->attr.allocated = 1;
+
+ if (sym->extra_loc.nextc == NULL)
+ sym->extra_loc = *loc;
+}
+
+
+bool gfc_lvalue_allocated_at (gfc_symbol *sym, locus *loc)
+{
+ if (sym->other_loc.nextc == 0)
+ sym->other_loc = *loc;
+
+ sym->attr.allocated = 1;
+ return true;
+}
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index 1bcbfdfd2c9..fee3461601f 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -657,6 +657,11 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym)
&& (sym->attr.dimension || sym->ts.type == BT_DERIVED))
TREE_READONLY (decl) = 1;
+ /* The front end already warned the user about this decl. Once should be
+ enough. */
+ if (sym->attr.warning_emitted)
+ suppress_warning (decl);
+
/* Chain this decl to the pending declarations. Don't do pushdecl()
because this would add them to the current scope rather than the
function scope. */
diff --git a/gcc/testsuite/gfortran.dg/allocatable_length.f90 b/gcc/testsuite/gfortran.dg/allocatable_length.f90
index e8b638fac88..8fd7002c57f 100644
--- a/gcc/testsuite/gfortran.dg/allocatable_length.f90
+++ b/gcc/testsuite/gfortran.dg/allocatable_length.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-Werror -Wall" }
+! { dg-options "-Werror -Wall -Wno-undefined-vars" }
module foo
contains
subroutine bar
diff --git a/gcc/testsuite/gfortran.dg/allocatable_scalar_6.f90 b/gcc/testsuite/gfortran.dg/allocatable_scalar_6.f90
index d21e8daea0e..4563957e081 100644
--- a/gcc/testsuite/gfortran.dg/allocatable_scalar_6.f90
+++ b/gcc/testsuite/gfortran.dg/allocatable_scalar_6.f90
@@ -1,5 +1,5 @@
! { dg-do run }
-! { dg-options "-Wall -pedantic" }
+! { dg-options "-Wall -pedantic -Wno-unused-but-set-variable" }
!
! PR fortran/41872
!
diff --git a/gcc/testsuite/gfortran.dg/allocatable_uninitialized_1.f90 b/gcc/testsuite/gfortran.dg/allocatable_uninitialized_1.f90
index 4c52bd7192e..45853118ef6 100644
--- a/gcc/testsuite/gfortran.dg/allocatable_uninitialized_1.f90
+++ b/gcc/testsuite/gfortran.dg/allocatable_uninitialized_1.f90
@@ -1,8 +1,7 @@
! { dg-do compile }
-! { dg-options "-O -Wall" }
+! { dg-options "-O -Wall -Wno-unused-but-set-variable -Wno-undefined-vars" }
program main
real,allocatable:: a(:),b(:)
a(1)=2*b(1) ! { dg-warning "uninitialized" }
-
end
diff --git a/gcc/testsuite/gfortran.dg/assignment_4.f90 b/gcc/testsuite/gfortran.dg/assignment_4.f90
index 37fdbca9178..7656fbe48ee 100644
--- a/gcc/testsuite/gfortran.dg/assignment_4.f90
+++ b/gcc/testsuite/gfortran.dg/assignment_4.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-Wall" }
+! { dg-options "-Wall -Wno-undefined-vars" }
!
! PR 55855: [OOP] incorrect warning with procedure pointer component on pointer-valued base object
!
@@ -13,4 +13,5 @@
type(event), pointer :: myEvent
allocate(myEvent)
r=myEvent%task() ! { dg-warning "uninitialized" }
+ call foo(r)
end
diff --git a/gcc/testsuite/gfortran.dg/attr_deprecated-2.f90 b/gcc/testsuite/gfortran.dg/attr_deprecated-2.f90
index 97a365a7c4a..969b044594f 100644
--- a/gcc/testsuite/gfortran.dg/attr_deprecated-2.f90
+++ b/gcc/testsuite/gfortran.dg/attr_deprecated-2.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-additional-options "-Wall" }
+! { dg-additional-options "-Wall -Wno-undefined-vars" }
!
! Ensure that only those parameters are warned for which are actually used
!
diff --git a/gcc/testsuite/gfortran.dg/c_by_val_5.f90 b/gcc/testsuite/gfortran.dg/c_by_val_5.f90
index bbef6bda892..510f04d40bb 100644
--- a/gcc/testsuite/gfortran.dg/c_by_val_5.f90
+++ b/gcc/testsuite/gfortran.dg/c_by_val_5.f90
@@ -1,6 +1,6 @@
! { dg-do run }
! Overwrite -pedantic setting:
-! { dg-options "-Wall" }
+! { dg-options "-Wall -Wno-unused-but-set-variable" }
!
! Tests the fix for PR31668, in which %VAL was rejected for
! module and internal procedures.
diff --git a/gcc/testsuite/gfortran.dg/char_component_initializer_2.f90 b/gcc/testsuite/gfortran.dg/char_component_initializer_2.f90
index 4d9dc7ebd35..b9dda455fa3 100644
--- a/gcc/testsuite/gfortran.dg/char_component_initializer_2.f90
+++ b/gcc/testsuite/gfortran.dg/char_component_initializer_2.f90
@@ -13,4 +13,5 @@ program gfcbug62
i = 1
k = 1
if (tdefi(1) .ne. ctl%tdefi(1)) STOP 1
+ if (i /=1 .or. k /= 1) stop 2
end program gfcbug62
diff --git a/gcc/testsuite/gfortran.dg/char_length_1.f90 b/gcc/testsuite/gfortran.dg/char_length_1.f90
index 3f92f0efa90..497d67bc628 100644
--- a/gcc/testsuite/gfortran.dg/char_length_1.f90
+++ b/gcc/testsuite/gfortran.dg/char_length_1.f90
@@ -16,4 +16,5 @@ program test
a = (/ 'Takata ', 'Tanaka ', 'Hayashi' /)
b = "abc" ! { dg-error "no IMPLICIT" }
c = "abcdefg" ! { dg-warning "will be truncated" }
+ print *,a,b,c
end program test
diff --git a/gcc/testsuite/gfortran.dg/constructor_9.f90 b/gcc/testsuite/gfortran.dg/constructor_9.f90
index a61b63a0fe5..817db541d11 100644
--- a/gcc/testsuite/gfortran.dg/constructor_9.f90
+++ b/gcc/testsuite/gfortran.dg/constructor_9.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-Wall" }
+! { dg-options "-Wall -Wno-unused-but-set-variable" }
!
! PR 58471: [4.8/4.9 Regression] ICE on invalid with missing type constructor and -Wall
!
diff --git a/gcc/testsuite/gfortran.dg/gamma_2.f90 b/gcc/testsuite/gfortran.dg/gamma_2.f90
index 5b0e922cb92..529e32dac20 100644
--- a/gcc/testsuite/gfortran.dg/gamma_2.f90
+++ b/gcc/testsuite/gfortran.dg/gamma_2.f90
@@ -28,5 +28,6 @@ rsp = lgamma(rsp)
rdp = lgamma(rdp)
rsp = algama(rsp)
rdp = dlgama(rdp)
+print *,rsp,rdp
end subroutine foo
end
diff --git a/gcc/testsuite/gfortran.dg/gomp/allocate-10.f90 b/gcc/testsuite/gfortran.dg/gomp/allocate-10.f90
index e50db53c1a8..326c3845bb2 100644
--- a/gcc/testsuite/gfortran.dg/gomp/allocate-10.f90
+++ b/gcc/testsuite/gfortran.dg/gomp/allocate-10.f90
@@ -1,4 +1,4 @@
-! { dg-additional-options "-Wall -fdump-tree-gimple" }
+! { dg-additional-options "-Wall -fdump-tree-gimple -Wno-unused-but-set-variable" }
module m
use iso_c_binding
diff --git a/gcc/testsuite/gfortran.dg/io_constraints_8.f90 b/gcc/testsuite/gfortran.dg/io_constraints_8.f90
index e3272e4a388..f250054aecf 100644
--- a/gcc/testsuite/gfortran.dg/io_constraints_8.f90
+++ b/gcc/testsuite/gfortran.dg/io_constraints_8.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-fmax-errors=100 -Wall" }
+! { dg-options "-fmax-errors=100 -Wall -Wno-unused-but-set-variable" }
!
! PR fortran/48972
!
diff --git a/gcc/testsuite/gfortran.dg/label_5.f90 b/gcc/testsuite/gfortran.dg/label_5.f90
index 108246517b6..79ea44e1440 100644
--- a/gcc/testsuite/gfortran.dg/label_5.f90
+++ b/gcc/testsuite/gfortran.dg/label_5.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-Wall" }
+! { dg-options "-Wall -Wno-unused-but-set-variable" }
! PR fortran/27553
program pr27553
10: a=10 ! { dg-error "character in statement" }
diff --git a/gcc/testsuite/gfortran.dg/len_trim.f90 b/gcc/testsuite/gfortran.dg/len_trim.f90
index 77e3d30c669..de9c716b85f 100644
--- a/gcc/testsuite/gfortran.dg/len_trim.f90
+++ b/gcc/testsuite/gfortran.dg/len_trim.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-O -Wall -Wconversion-extra -fdump-tree-original" }
+! { dg-options "-O -Wall -Wconversion-extra -fdump-tree-original -Wno-unused-but-set-variable" }
! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } }
! PR fortran/87711 - ICE in gfc_trans_transfer
! PR fortran/87851 - return type for len_trim
diff --git a/gcc/testsuite/gfortran.dg/linefile.f90 b/gcc/testsuite/gfortran.dg/linefile.f90
index 8e1366b0802..430563f7192 100644
--- a/gcc/testsuite/gfortran.dg/linefile.f90
+++ b/gcc/testsuite/gfortran.dg/linefile.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-Wall" }
+! { dg-options "-Wall -Wno-unused-but-set-variable" }
! This will verify that the # <line> <file> directive later does not
! mess up the diagnostic on this line
diff --git a/gcc/testsuite/gfortran.dg/pointer_check_13.f90 b/gcc/testsuite/gfortran.dg/pointer_check_13.f90
index f936f2d745b..351c395f83a 100644
--- a/gcc/testsuite/gfortran.dg/pointer_check_13.f90
+++ b/gcc/testsuite/gfortran.dg/pointer_check_13.f90
@@ -13,7 +13,7 @@ contains
implicit none
integer, target :: so
integer, pointer :: sp
- sp => so
+ sp => so ! { dg-warning "but never used" }
return
end function So
end module s
diff --git a/gcc/testsuite/gfortran.dg/pr102366.f90 b/gcc/testsuite/gfortran.dg/pr102366.f90
index d002f64a8ae..6acebcbb20c 100644
--- a/gcc/testsuite/gfortran.dg/pr102366.f90
+++ b/gcc/testsuite/gfortran.dg/pr102366.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-fdump-tree-original -Wall" }
+! { dg-options "-fdump-tree-original -Wall -Wno-unused-but-set-variable" }
! { dg-final { scan-tree-dump-times "static real" 1 "original" } }
! PR fortran/102366 - large arrays no longer become static
diff --git a/gcc/testsuite/gfortran.dg/pr103475.f90 b/gcc/testsuite/gfortran.dg/pr103475.f90
index 6cce5e8ebf7..10c9984e4ae 100644
--- a/gcc/testsuite/gfortran.dg/pr103475.f90
+++ b/gcc/testsuite/gfortran.dg/pr103475.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-O2 -Wall" }
+! { dg-options "-O2 -Wall -Wno-unused-but-set-variable" }
! PR fortran/103475 - ICE in gfc_expr_attr
! Contributed by G.Steinmetz
diff --git a/gcc/testsuite/gfortran.dg/pr91497.f90 b/gcc/testsuite/gfortran.dg/pr91497.f90
index f4005e503e4..22dcaf3808c 100644
--- a/gcc/testsuite/gfortran.dg/pr91497.f90
+++ b/gcc/testsuite/gfortran.dg/pr91497.f90
@@ -1,7 +1,7 @@
! { dg-do compile }
! { dg-require-effective-target fortran_real_10 }
! { dg-require-effective-target fortran_real_16 }
-! { dg-options "-Wall" }
+! { dg-options "-Wall -Wno-unused-but-set-variable" }
! Code contributed by Manfred Schwarb <manfred99 at gmx dot ch>
! PR fortran/91497
!
diff --git a/gcc/testsuite/gfortran.dg/pr91497_2.f90 b/gcc/testsuite/gfortran.dg/pr91497_2.f90
index 28aa4bd1872..a714b42125f 100644
--- a/gcc/testsuite/gfortran.dg/pr91497_2.f90
+++ b/gcc/testsuite/gfortran.dg/pr91497_2.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-Wall" }
+! { dg-options "-Wall -Wno-unused-but-set-variable" }
! Code contributed by Manfred Schwarb <manfred99 at gmx dot ch>
! PR fortran/91497
!
diff --git a/gcc/testsuite/gfortran.dg/pr96312.f90 b/gcc/testsuite/gfortran.dg/pr96312.f90
index d6d8e79119f..81e9a3502bb 100644
--- a/gcc/testsuite/gfortran.dg/pr96312.f90
+++ b/gcc/testsuite/gfortran.dg/pr96312.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-O1 -Wall" }
+! { dg-options "-O1 -Wall -Wno-unused-but-set-variable" }
!
! PR fortran/96312. The line with the call to 'matmul' gave the warning
! ‘tmp.dim[0].lbound’ is used uninitialized in this function
diff --git a/gcc/testsuite/gfortran.dg/pr98411.f90 b/gcc/testsuite/gfortran.dg/pr98411.f90
index 7c906a96f60..83eef11fbc6 100644
--- a/gcc/testsuite/gfortran.dg/pr98411.f90
+++ b/gcc/testsuite/gfortran.dg/pr98411.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-std=f2008 -Wall -fautomatic -fmax-stack-var-size=100" }
+! { dg-options "-std=f2008 -Wall -fautomatic -fmax-stack-var-size=100 -Wno-unused-but-set-variable" }
! PR fortran/98411 - Pointless warning for static variables
module try
diff --git a/gcc/testsuite/gfortran.dg/transfer_check_4.f90 b/gcc/testsuite/gfortran.dg/transfer_check_4.f90
index 030d3454909..4474f8a846d 100644
--- a/gcc/testsuite/gfortran.dg/transfer_check_4.f90
+++ b/gcc/testsuite/gfortran.dg/transfer_check_4.f90
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "-Wall" }
+! { dg-options "-Wall -Wno-unused-but-set-variable" }
! PR 57022: [4.7/4.8/4.9 Regression] Inappropriate warning for use of TRANSFER with arrays
! Contributed by William Clodius <[email protected]>
diff --git a/gcc/testsuite/gfortran.dg/warn_undefined_vars_1.f90 b/gcc/testsuite/gfortran.dg/warn_undefined_vars_1.f90
new file mode 100644
index 00000000000..dbcfa2b4e02
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_undefined_vars_1.f90
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-Wundefined-vars" }
+program memain
+ implicit none
+ integer, dimension(:), allocatable :: a
+ integer, allocatable :: d
+ integer, dimension(10) :: e
+ integer :: f, g, h, i
+ real, dimension(:), allocatable :: r
+ allocate (a(10))
+ call s1(a) ! { dg-warning "Allocated.*INTENT.IN." }
+ allocate (d, source=42)
+ print *,d
+ call s2(f) ! { dg-warning "Undefined variable" }
+ print *,g ! { dg-warning "Undefined variable.*used" }
+ call s3(h,i)
+ print *,i
+ call allocit(r)
+ print *,r
+contains
+ subroutine s1(in)
+ integer, dimension(:), intent(in) :: in
+ print *,in
+ end subroutine s1
+ subroutine s2(in)
+ integer, value :: in
+ print *,in
+ end subroutine s2
+ subroutine allocit(fld)
+ real, dimension(:), intent(out), allocatable :: fld
+ fld = [1,2,3]
+ end subroutine allocit
+end program memain
+
diff --git a/gcc/testsuite/gfortran.dg/warn_undefined_vars_2.f90 b/gcc/testsuite/gfortran.dg/warn_undefined_vars_2.f90
new file mode 100644
index 00000000000..af1a0645930
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_undefined_vars_2.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-Wundefined-vars" }
+program memain
+ implicit none
+ integer, allocatable :: b, c, d
+ integer, dimension(10) :: e
+ integer :: f, g, h, i
+ real, dimension(:), allocatable :: r
+ allocate (b)
+ call s2(b) ! { dg-warning "Allocated variable.*VALUE" }
+contains
+ subroutine s2(in)
+ integer, value :: in
+ print *,in
+ end subroutine s2
+end program memain
+
diff --git a/gcc/testsuite/gfortran.dg/warn_undefined_vars_3.f90 b/gcc/testsuite/gfortran.dg/warn_undefined_vars_3.f90
new file mode 100644
index 00000000000..86a06ddb234
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_undefined_vars_3.f90
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! { dg-options "-Wundefined-vars" }
+program memain
+ implicit none
+ integer, allocatable :: c
+ integer, dimension(10) :: e
+ allocate (c)
+ print *,c ! { dg-warning "Allocated.*undefined" }
+contains
+ subroutine s1(in)
+ integer, dimension(:), intent(in) :: in
+ print *,in
+ end subroutine s1
+
+end program memain
diff --git a/gcc/testsuite/gfortran.dg/warn_undefined_vars_4.f90 b/gcc/testsuite/gfortran.dg/warn_undefined_vars_4.f90
new file mode 100644
index 00000000000..928f3009919
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_undefined_vars_4.f90
@@ -0,0 +1,17 @@
+! { dg-do compile }
+! { dg-options "-Wundefined-vars" }
+program memain
+ integer, dimension(10) :: e
+ call s1(e) ! { dg-warning "Undefined.*passed to INTENT.IN. argument" }
+contains
+ subroutine s1(in)
+ integer, dimension(:), intent(in) :: in
+ print *,in
+ end subroutine s1
+end program memain
+
+subroutine s3(a, b)
+ integer, intent(out) :: a
+ integer, intent(inout) :: b
+ b = a + 1 ! { dg-warning "Undefined INTENT.OUT. variable" }
+end subroutine s3
diff --git a/gcc/testsuite/gfortran.dg/warn_unused_but_set_1.f90 b/gcc/testsuite/gfortran.dg/warn_unused_but_set_1.f90
new file mode 100644
index 00000000000..c6c0817dc9b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_unused_but_set_1.f90
@@ -0,0 +1,54 @@
+! { dg-do compile }
+! { dg-options "-Wunused-but-set-variable" }
+module x
+ implicit none
+contains
+ subroutine tst1
+ character(len=100) :: iomsg
+ character(len=30) :: outstring
+ integer :: ios, u, n
+ real :: x
+ integer, dimension(:), allocatable :: a1, a2
+ inquire (6, iostat=ios) ! { dg-warning "never used" }
+ inquire (6, iomsg=iomsg) ! { dg-warning "never used" }
+ write (outstring,'(A)') "Hello, world" ! { dg-warning "never used" }
+ x = 42. ! { dg-warning "never used" }
+ open (newunit=u,file="asdf.txt") ! { dg-warning "never used" }
+ n = 10
+ allocate(a1(n)) ! { dg-warning "allocated at" }
+ allocate(a2(n))
+ a2 = 42 ! { dg-warning "never used" }
+ end subroutine tst1
+ ! Test a few combinations that should not emit warnings
+ subroutine tst2
+ integer i, n, m,k,l
+ integer, target:: it
+ integer, pointer :: p
+ real, allocatable :: r
+ real :: x
+ integer, dimension(:), allocatable :: ia
+
+ n = 12
+ l = 2
+ do i=1,n,l
+ end do
+ m = 12
+ k = 3
+ forall (i=1:m:k)
+ end forall
+ p => it
+ p = 42
+ print *,p
+ allocate(r)
+ r = 42.
+ print *,r
+ x = 42.
+ call in(x+4.)
+ ia = [1, 2, 3]
+ print *,ia
+ end subroutine tst2
+ subroutine in(x)
+ real, intent(in) :: x
+ print *,x
+ end subroutine in
+end module x
diff --git a/gcc/testsuite/gfortran.dg/warn_unused_intent_out_1.f90 b/gcc/testsuite/gfortran.dg/warn_unused_intent_out_1.f90
new file mode 100644
index 00000000000..6073d60f4bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_unused_intent_out_1.f90
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! { dg-additional-options "-Wunused-intent-out" }
+module y
+ implicit none
+contains
+ subroutine tst
+ real :: a, b
+ call intent_out(a) ! { dg-warning "passed to INTENT\\(OUT\\)" }
+ call intent_out(b)
+ print *,b
+ end subroutine tst
+ subroutine intent_out(x)
+ real, intent(out) :: x
+ x = 0.4
+ end subroutine intent_out
+end module y
diff --git a/gcc/testsuite/gfortran.dg/warn_unused_read_1.f90 b/gcc/testsuite/gfortran.dg/warn_unused_read_1.f90
new file mode 100644
index 00000000000..28d9f6cf39d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_unused_read_1.f90
@@ -0,0 +1,8 @@
+! { dg-do compile }
+! { dg-additional-options "-Wunused-read" }
+program main
+ real :: x, y
+ read (*,*) x ! { dg-warning "read at" }
+ read (*,*) y
+ print *,y
+end program main
diff --git a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90 b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90
index 1f9d38d794f..19a892083c3 100644
--- a/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90
+++ b/gcc/testsuite/gfortran.dg/warnings_are_errors_1.f90
@@ -19,7 +19,7 @@
! gfc_warning:
1234 complex :: cplx ! { dg-error "defined but cannot be used" }
cplx = 20.
-
+ print *,cplx
end
! { dg-final { output-exists-not } }
! { dg-prune-output "warnings being treated as errors" }
diff --git a/libgfortran/mk-kinds-h.sh b/libgfortran/mk-kinds-h.sh
index 647b3b6eadb..6198dba7412 100755
--- a/libgfortran/mk-kinds-h.sh
+++ b/libgfortran/mk-kinds-h.sh
@@ -18,6 +18,7 @@ smallest=""
for k in $possible_integer_kinds; do
echo " integer (kind=$k) :: i" > tmp$$.f90
echo " i = 1_$k" >> tmp$$.f90
+ echo " print *,i" >> tmp$$.f90
echo " end" >> tmp$$.f90
if $compile -S tmp$$.f90 > /dev/null 2>&1; then
s=`expr 8 \* $k`
@@ -61,6 +62,7 @@ rm -f tmq$$.*
for k in $possible_real_kinds; do
echo " real (kind=$k) :: x" > tmp$$.f90
echo " x = 1.0_$k" >> tmp$$.f90
+ echo " print *,x" >> tmp$$.f90
echo " end" >> tmp$$.f90
if $compile -S tmp$$.f90 > /dev/null 2>&1; then
case $k in
diff --git a/libgfortran/mk-sik-inc.sh b/libgfortran/mk-sik-inc.sh
index e7f237ec526..afbae1149f7 100755
--- a/libgfortran/mk-sik-inc.sh
+++ b/libgfortran/mk-sik-inc.sh
@@ -15,6 +15,7 @@ c=0
for k in $possible_integer_kinds; do
echo " integer (kind=$k) :: x" > tmp$$.f90
echo " x = 1_$k" >> tmp$$.f90
+ echo " print *,x" >> tmp$$.f90
echo " end" >> tmp$$.f90
if $compile -S tmp$$.f90 > /dev/null 2>&1; then
kinds="$kinds $k"
diff --git a/libgfortran/mk-srk-inc.sh b/libgfortran/mk-srk-inc.sh
index d9f2137f89d..e089c7326d4 100755
--- a/libgfortran/mk-srk-inc.sh
+++ b/libgfortran/mk-srk-inc.sh
@@ -15,6 +15,7 @@ c=0
for k in $possible_real_kinds; do
echo " real (kind=$k) :: x" > tmp$$.f90
echo " x = 1.0_$k" >> tmp$$.f90
+ echo " print *,x" >> tmp$$.f90
echo " end" >> tmp$$.f90
if $compile -S tmp$$.f90 > /dev/null 2>&1; then
kinds="$kinds $k"
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-1.F90 b/libgomp/testsuite/libgomp.fortran/alloc-1.F90
index 7e051692eec..251aca0d999 100644
--- a/libgomp/testsuite/libgomp.fortran/alloc-1.F90
+++ b/libgomp/testsuite/libgomp.fortran/alloc-1.F90
@@ -48,7 +48,7 @@
call c_f_pointer (cp, p, [3])
p(1) = 1
p(2) = 2
- p(3) = 3
+ p(3) = p(1) + p(2) ! Shut up -Wunused-but-set-variable
call omp_free (cp, omp_default_mem_alloc)
cp = omp_alloc (2_c_size_t * c_sizeof (i), &
@@ -64,6 +64,7 @@
if (mod (transfer (cp, intptr), 4_c_intptr_t) /= 0) stop 3
call c_f_pointer (cp, p0)
p0 = 3
+ p0 = p0 + 0 ! Shut up -Wunused-but-set-variable
call omp_free (cp, omp_get_default_allocator ())
traits = [omp_alloctrait (omp_atk_alignment, 64), &
@@ -115,12 +116,14 @@
if (mod (transfer (cq, intptr), 16_c_intptr_t) /= 0) stop 12
call c_f_pointer (cq, q, [768 / c_sizeof (i)])
q(1) = 7
+ q(1) = q(1) + 0 ! Shut up -Wunused-but-set-variable
q(768 / c_sizeof (i)) = 8
cr = omp_alloc (512_c_size_t, a2)
if (mod (transfer (cr, intptr), 4_c_intptr_t) /= 0) stop 13
call c_f_pointer (cr, r, [512 / c_sizeof (i)])
r(1) = 9
r(512 / c_sizeof (i)) = 10
+ r(1) = r(1) + 0 ! Shut up -Wunused-but-set-variable
call omp_free (cp, omp_null_allocator)
call omp_free (cq, a2)
call omp_free (cr, omp_null_allocator)
diff --git a/libgomp/testsuite/libgomp.fortran/alloc-12.f90 b/libgomp/testsuite/libgomp.fortran/alloc-12.f90
index 3d10959a018..afd13dde36c 100644
--- a/libgomp/testsuite/libgomp.fortran/alloc-12.f90
+++ b/libgomp/testsuite/libgomp.fortran/alloc-12.f90
@@ -23,6 +23,7 @@ program main
ip(1) = 1
ip(2) = 2
ip(3) = 3
+ if (ip(3) /= 3) stop 1
call omp_free (p, a)
call omp_destroy_allocator (a)
end program main
