2012-04-19 Tobias Burnus <burnus@net-b.de>
PR fortran/52196
* lang.opt (Wrealloc-lhs, Wrealloc-lhs-all): New flags.
* gfortran.h (gfc_option_t): Add them.
* options.c (gfc_init_options, gfc_post_options,
gfc_handle_option): Handle them.
* invoke.texi: Document them.
* trans-expr.c (realloc_lhs_warning): New function.
(gfc_trans_arrayfunc_assign,
alloc_scalar_allocatable_for_assignment,
gfc_trans_assignment_1): Use it.
2012-04-19 Tobias Burnus <burnus@net-b.de>
PR fortran/52196
* gfortran.dg/realloc_on_assign_14.f90: New.
===================================================================
@@ -2219,6 +2219,8 @@ typedef struct
int warn_align_commons;
int warn_real_q_constant;
int warn_unused_dummy_argument;
+ int warn_realloc_lhs;
+ int warn_realloc_lhs_all;
int max_errors;
int flag_all_intrinsics;
===================================================================
@@ -146,9 +146,8 @@ and warnings}.
-Wconversion -Wfunction-elimination -Wimplicit-interface @gol
-Wimplicit-procedure -Wintrinsic-shadow -Wintrinsics-std @gol
-Wline-truncation -Wno-align-commons -Wno-tabs -Wreal-q-constant @gol
--Wsurprising -Wunderflow -Wunused-parameter -fmax-errors=@var{n}
--fsyntax-only @gol
--pedantic -pedantic-errors
+-Wsurprising -Wunderflow -Wunused-parameter -Wrealloc-lhs Wrealloc-lhs-all @gol
+-fmax-errors=@var{n} -fsyntax-only -pedantic -pedantic-errors
}
@item Debugging Options
@@ -919,7 +918,24 @@ off via @option{-Wno-align-commons}. See also @opt
Warn if any calls to functions are eliminated by the optimizations
enabled by the @option{-ffrontend-optimize} option.
+@item -Wrealloc-lhs
+@opindex @code{Wrealloc-lhs}
+@cindex Reallocate the LHS in assignments, notification
+Warn when the compiler might insert code to for allocation or reallocation of
+an allocatable array variable of intrinsic type in intrinsic assignments. In
+hot loops, the Fortran 2003 reallocation feature may reduce the performance.
+If the array is already allocated with the correct shape, consider using a
+whole-array array-spec (e.g. @code{(:,:,:)}) for the variable on the left-hand
+side to prevent the reallocation check. Note that in some cases the warning
+is shown, even if the compiler will optimize reallocation checks away. For
+instance, when the right-hand side contains the same variable multiplied by
+a scalar. See also @option{-frealloc-lhs}.
+@item -Wrealloc-lhs-all
+@opindex @code{Wrealloc-lhs-all}
+Warn when the compiler inserts code to for allocation or reallocation of an
+allocatable variable; this includes scalars and derived types.
+
@item -Werror
@opindex @code{Werror}
@cindex warnings, to errors
@@ -1561,7 +1577,8 @@ need to be in effect. The parentheses protection i
@cindex Reallocate the LHS in assignments
An allocatable left-hand side of an intrinsic assignment is automatically
(re)allocated if it is either unallocated or has a different shape. The
-option is enabled by default except when @option{-std=f95} is given.
+option is enabled by default except when @option{-std=f95} is given. See
+also @option{-Wrealloc-lhs}.
@item -faggressive-function-elimination
@opindex @code{faggressive-function-elimination}
===================================================================
@@ -250,6 +250,14 @@ Wreal-q-constant
Fortran Warning
Warn about real-literal-constants with 'q' exponent-letter
+Wrealloc-lhs
+Fortran Warning
+Warn when a left-hand-side array variable is reallocated
+
+Wrealloc-lhs-all
+Fortran Warning
+Warn when a left-hand-side variable is reallocated
+
Wreturn-type
Fortran Warning
; Documented in C
===================================================================
@@ -111,6 +111,8 @@ gfc_init_options (unsigned int decoded_options_cou
gfc_option.warn_align_commons = 1;
gfc_option.warn_real_q_constant = 0;
gfc_option.warn_unused_dummy_argument = 0;
+ gfc_option.warn_realloc_lhs = 0;
+ gfc_option.warn_realloc_lhs_all = 0;
gfc_option.max_errors = 25;
gfc_option.flag_all_intrinsics = 0;
@@ -437,6 +439,9 @@ gfc_post_options (const char **pfilename)
if (gfc_option.flag_frontend_optimize == -1)
gfc_option.flag_frontend_optimize = optimize;
+ if (gfc_option.warn_realloc_lhs_all)
+ gfc_option.warn_realloc_lhs = 1;
+
gfc_cpp_post_options ();
/* FIXME: return gfc_cpp_preprocess_only ();
@@ -654,6 +659,14 @@ gfc_handle_option (size_t scode, const char *arg,
gfc_option.warn_line_truncation = value;
break;
+ case OPT_Wrealloc_lhs:
+ gfc_option.warn_realloc_lhs = value;
+ break;
+
+ case OPT_Wrealloc_lhs_all:
+ gfc_option.warn_realloc_lhs_all = value;
+ break;
+
case OPT_Wreturn_type:
warn_return_type = value;
break;
===================================================================
@@ -581,6 +581,19 @@ assign:
/* End of prototype trans-class.c */
+static void
+realloc_lhs_warning (bt type, bool array, locus *where)
+{
+ if (array && type != BT_CLASS && type != BT_DERIVED
+ && gfc_option.warn_realloc_lhs)
+ gfc_warning ("Code for reallocating the allocatable array at %L will "
+ "be added", where);
+ else if (gfc_option.warn_realloc_lhs_all)
+ gfc_warning ("Code for reallocating the allocatable variable at %L "
+ "will be added", where);
+}
+
+
static tree gfc_trans_structure_assign (tree dest, gfc_expr * expr);
static void gfc_apply_interface_mapping_to_expr (gfc_interface_mapping *,
gfc_expr *);
@@ -6479,6 +6493,8 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_
&& !(expr2->value.function.esym
&& expr2->value.function.esym->result->attr.allocatable))
{
+ realloc_lhs_warning (expr1->ts.type, true, &expr1->where);
+
if (!expr2->value.function.isym)
{
realloc_lhs_loop_for_fcn_call (&se, &expr1->where, &ss, &loop);
@@ -6740,6 +6756,8 @@ alloc_scalar_allocatable_for_assignment (stmtblock
if (!expr2 || expr2->rank)
return;
+ realloc_lhs_warning (expr2->ts.type, false, &expr2->where);
+
/* Since this is a scalar lhs, we can afford to do this. That is,
there is no risk of side effects being repeated. */
gfc_init_se (&lse, NULL);
@@ -6988,7 +7006,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr
{
/* F2003: Add the code for reallocation on assignment. */
if (gfc_option.flag_realloc_lhs
- && is_scalar_reallocatable_lhs (expr1))
+ && is_scalar_reallocatable_lhs (expr1))
alloc_scalar_allocatable_for_assignment (&block, rse.string_length,
expr1, expr2);
@@ -7031,8 +7049,10 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr
if (gfc_option.flag_realloc_lhs
&& gfc_is_reallocatable_lhs (expr1)
&& !gfc_expr_attr (expr1).codimension
- && !gfc_is_coindexed (expr1))
+ && !gfc_is_coindexed (expr1)
+ && expr2->rank)
{
+ realloc_lhs_warning (expr1->ts.type, true, &expr1->where);
ompws_flags &= ~OMPWS_SCALARIZER_WS;
tmp = gfc_alloc_allocatable_for_assignment (&loop, expr1, expr2);
if (tmp != NULL_TREE)
===================================================================
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! { dg-options "-Wrealloc-lhs-all -Wrealloc-lhs" }
+!
+! PR fortran/52196
+!
+implicit none
+type t
+ integer :: x
+end type t
+integer, allocatable :: a(:), b
+real, allocatable :: r(:)
+type(t), allocatable :: c(:)
+character(len=:), allocatable :: str
+character(len=:), allocatable :: astr(:)
+
+allocate(a(2), b, c(1))
+b = 4 ! { dg-warning "Code for reallocating the allocatable variable" }
+a = [b,b] ! { dg-warning "Code for reallocating the allocatable array" }
+c = [t(4)] ! { dg-warning "Code for reallocating the allocatable variable" }
+a = 5 ! no realloc
+c = t(5) ! no realloc
+str = 'abc' ! { dg-warning "Code for reallocating the allocatable variable" }
+astr = 'abc' ! no realloc
+astr = ['abc'] ! { dg-warning "Code for reallocating the allocatable array" }
+a = reshape(a,shape(a)) ! { dg-warning "Code for reallocating the allocatable array" }
+r = sin(r) ! { dg-warning "Code for reallocating the allocatable array" }
+r = sin(r(1)) ! no realloc
+b = sin(r(1)) ! { dg-warning "Code for reallocating the allocatable variable" }
+
+a = nar() ! { dg-warning "Code for reallocating the allocatable array" }
+a = nar2() ! { dg-warning "Code for reallocating the allocatable array" }
+contains
+ function nar()
+ integer,allocatable :: nar(:)
+ end function
+ function nar2()
+ integer :: nar2(8)
+ end function
+end