Hello world,
what it says in the ChangeLog.
Regression-tested. (I am now using
make -j16 check-fortran 2>&1 | tee outfile | grep -i fail
as a way to only get the relevant parts for failure, which means
that I no longer need to scroll up. Maybe this is also useful for
other people).
OK for trunk?
Best regards
Thomas
Fix some more issues with -Wunused-but-set and -Wundefined-vars.
The root cause for PR 126058 that was that sym->extra_loc was not
being set for possible allocations via allocatablearguments. Looking
at the code, a few more problems became clear: Not only INTENT(OUT)
arguments could allocate allocatables, all other INTENTS could do so
as well, but only if the formal arguments are allocatable as well.
Also, curent intrinsics do not have allocatable components.
During testing, there were also a few cases where, if one warning with
-Wall and one with -Wextra applied, the one with -Wextra was issued
peferably.
This is slightly confusing, and also fixed with this patch.
gcc/fortran/ChangeLog:
PR fortran/126058
* gfortran.h (enum var_allocated): New enum.
(symbol_attribute): Change member allocated to new enum.
(gfc_used_in_allocate_expr): Add argument how.
* interface.cc (gfc_compare_actual_formal): Mark variables
as allocated only when the formal arg is allocatable.
* intrinsic.cc (mark_args_as_used): Intrinsics do not allocate
their arguments.
* resolve.cc (find_unused_vs_set): Move warnings enabled with
-Wextra behind those enabled with -Wall. If a variable is
maybe allocated as an argument, mark it as such.
* symbol.cc (mark_vars_as_used): Always set location.
(gfc_used_in_allocate_expr): Add argument how. Use it.
(gfc_lvalue_allocated_at): Set sym->attr.allocated to
ALLOCATED_ASSIGNMENT.
gcc/testsuite/ChangeLog:
PR fortran/126058
* gfortran.dg/warn_undefined_vars_7.f90: New test.
* gfortran.dg/warn_unused_but_set_variable_4.f90: New test.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 062e9b0c9d8..df987576fff 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -421,6 +421,15 @@ enum value_used
VALUE_USED
};
+/* How a variable is allocated. */
+enum var_allocated
+{
+ ALLOCATED_NEVER = 0,
+ ALLOCATED_ARG,
+ ALLOCATED_ALLOCATE_STMT,
+ ALLOCATED_ASSIGNMENT
+};
+
/* 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. */
@@ -1039,7 +1048,7 @@ typedef struct
ENUM_BITFIELD (value_used) value_used:3;
/* Set if the symbol has been allocated in the current procedure. */
- unsigned allocated:1;
+ ENUM_BITFIELD (var_allocated) allocated:2;
/* Set if we already emitted a warning for this symbol and the
middle-end should not add additional ones. */
@@ -4013,7 +4022,7 @@ 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);
+void gfc_used_in_allocate_expr (gfc_expr *, locus *loc, enum var_allocated);
void gfc_expr_set_at (gfc_expr *, locus *loc, enum value_set);
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 32152bd6777..bff3239be28 100644
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -4269,21 +4269,24 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
{
case INTENT_OUT:
{
- gfc_symbol *s = e->symtree->n.sym;
gfc_expr_set_at (e, &e->where, VALUE_INTENT_OUT);
+ if (f->sym->attr.allocatable)
+ gfc_used_in_allocate_expr (e, &e->where, ALLOCATED_ARG);
- /* 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);
+
+ if (f->sym->attr.allocatable)
+ gfc_used_in_allocate_expr (e, &e->where, ALLOCATED_ARG);
break;
}
}
diff --git a/gcc/fortran/intrinsic.cc b/gcc/fortran/intrinsic.cc
index 12b6d30c71f..0d25de4d9d2 100644
--- a/gcc/fortran/intrinsic.cc
+++ b/gcc/fortran/intrinsic.cc
@@ -5029,12 +5029,7 @@ mark_args_as_used (gfc_intrinsic_arg *f, gfc_actual_arglist *a)
case INTENT_OUT:
if (a->expr->expr_type == EXPR_VARIABLE)
- {
- gfc_symbol *s = a->expr->symtree->n.sym;
- gfc_expr_set_at (a->expr, &a->expr->where, VALUE_INTENT_OUT);
- if (s->attr.allocatable)
- s->attr.allocated = 1;
- }
+ gfc_expr_set_at (a->expr, &a->expr->where, VALUE_INTENT_OUT);
break;
}
}
diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index d55aaa2080a..c73911f6cfb 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -9750,7 +9750,7 @@ check_symbols:
}
success:
- gfc_used_in_allocate_expr (e, &e->where);
+ gfc_used_in_allocate_expr (e, &e->where, ALLOCATED_ALLOCATE_STMT);
if (code->expr3)
gfc_value_set_at (e->symtree->n.sym, &code->expr3->where, VALUE_VARDEF);
@@ -20819,24 +20819,6 @@ find_unused_vs_set (gfc_symbol *sym)
|| attr->volatile_ || attr->asynchronous || !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
@@ -20949,15 +20931,50 @@ find_unused_vs_set (gfc_symbol *sym)
attr->warning_emitted = 1;
return;
}
- if (attr->allocatable && attr->allocated && !var_value_is_used (sym))
+ if (attr->allocatable && !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;
+ if (attr->allocated == ALLOCATED_ALLOCATE_STMT)
+ {
+ 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;
+ }
+ else if (attr->allocated == ALLOCATED_ARG)
+ {
+ gfc_warning (OPT_Wunused_but_set_variable_, "Variable %qs maybe "
+ "allocated as argument at %L but never used",
+ sym->name, &sym->extra_loc);
+ attr->warning_emitted = 1;
+ return;
+ }
}
}
+
+ /* -Wunused-intent-out and -Wunused-read are enabled with -Wextra, so
+ check for these conditions at the end. If one of the warnings
+ with -Wall triggered, we do not want to issue a different warrning
+ for the same variable if the user supplies -Wall -Wextra instead
+ of only -Wall. */
+
+ 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;
+ }
}
/* Run warn_unused_vs_set over a namespace recursively. */
diff --git a/gcc/fortran/symbol.cc b/gcc/fortran/symbol.cc
index 72ffa191954..1349fe3a2fb 100644
--- a/gcc/fortran/symbol.cc
+++ b/gcc/fortran/symbol.cc
@@ -5857,8 +5857,7 @@ mark_vars_as_used (gfc_expr **e, int *walk_subtrees, void *data)
return 0;
sym->attr.value_used = how_used;
- if (sym->other_loc.nextc == NULL)
- sym->other_loc = expr->where;
+ sym->other_loc = expr->where;
return 0;
}
@@ -5894,7 +5893,7 @@ gfc_value_set_and_used (gfc_expr *expr, locus *loc, enum value_set how_set,
/* 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_used_in_allocate_expr (gfc_expr *expr, locus *loc, enum var_allocated how)
{
gfc_symbol *sym;
enum value_used prev_used;
@@ -5909,13 +5908,17 @@ gfc_used_in_allocate_expr (gfc_expr *expr, locus *loc)
gfc_value_used_expr (expr, VALUE_USED);
sym->attr.value_used = prev_used;
sym->other_loc = prev_loc;
- sym->attr.allocated = 1;
+
+ if (how <= sym->attr.allocated)
+ return;
+
+ sym->attr.allocated = how;
if (sym->extra_loc.nextc == NULL)
sym->extra_loc = *loc;
}
-/* Mark a symbol to allocated. */
+/* Mark a symbol as allocated. */
bool
gfc_lvalue_allocated_at (gfc_symbol *sym, locus *loc)
@@ -5923,7 +5926,7 @@ gfc_lvalue_allocated_at (gfc_symbol *sym, locus *loc)
if (sym->other_loc.nextc == 0)
sym->other_loc = *loc;
- sym->attr.allocated = 1;
+ sym->attr.allocated = ALLOCATED_ASSIGNMENT;
return true;
}
diff --git a/gcc/testsuite/gfortran.dg/warn_undefined_vars_7.f90 b/gcc/testsuite/gfortran.dg/warn_undefined_vars_7.f90
new file mode 100644
index 00000000000..7d83cc68543
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_undefined_vars_7.f90
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! { dg-additional-options "-Wundefined-vars" }
+
+! Allocatable variables passed to INTENT(OUT) formal arguments can
+! only be considered allocated if the formal argument is allocatable.
+
+module m
+ implicit none
+ interface
+ subroutine no_allocation(x)
+ real, dimension(:), intent(out) :: x
+ end subroutine no_allocation
+ end interface
+ interface
+ subroutine allocation(x)
+ real, dimension(:), intent(out), allocatable :: x
+ end subroutine allocation
+ end interface
+contains
+ subroutine foo
+ real, allocatable :: x(:)
+ call no_allocation(x)
+ print *,x ! { dg-warning "Unallocated variable.*referenced" }
+ end subroutine foo
+ subroutine bar
+ real, allocatable :: x(:)
+ call allocation(x)
+ print *,x
+ end subroutine bar
+end module m
diff --git a/gcc/testsuite/gfortran.dg/warn_unused_but_set_variable_4.f90 b/gcc/testsuite/gfortran.dg/warn_unused_but_set_variable_4.f90
new file mode 100644
index 00000000000..c36a7389993
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/warn_unused_but_set_variable_4.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-additional-options "-Wall" }
+! PR 126058 - this used to give an ICE.
+PROGRAM p
+ IMPLICIT NONE
+ TYPE t1
+ INTEGER, ALLOCATABLE :: i(:)
+ END TYPE t1
+ call leak
+CONTAINS
+ SUBROUTINE s1(e)
+ TYPE(t1), ALLOCATABLE, INTENT(OUT) :: e(:)
+ ALLOCATE( e(1) )
+ ALLOCATE( e(1)%i(2) )
+ END SUBROUTINE s1
+ SUBROUTINE leak
+ TYPE(t1), ALLOCATABLE :: e(:)
+ CALL s1(e) ! { dg-warning "maybe allocated" }
+ CALL s1(e)
+ END SUBROUTINE leak
+END PROGRAM p
