2012-04-25 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-25  Tobias Burnus  <burnus@net-b.de>

        PR fortran/52196
        * gfortran.dg/realloc_on_assign_14.f90: New.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@186806 138bc75d-0d04-0410-961f-82ee72b054a4

8 files changed, 122 insertions, 6 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index cfe1192b6ef..f5ce12c94f6 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,16 @@
+2012-04-25  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-18  Steven Bosscher  <steven@gcc.gnu.org>
 
 	* trans-decl.c (gfc_trans_entry_master_switch): Build SWITCH_EXPR
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 25bdfa5ca3c..1143314db7b 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -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;
diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi
index 38ebfe991b2..8db869bfa68 100644
--- a/gcc/fortran/invoke.texi
+++ b/gcc/fortran/invoke.texi
@@ -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,6 +918,23 @@ off via @option{-Wno-align-commons}. See also @option{-falign-commons}.
 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}
@@ -1561,7 +1577,8 @@ need to be in effect. The parentheses protection is enabled by default, unless
 @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}
diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt
index 7e160a0c456..3b9d29b0328 100644
--- a/gcc/fortran/lang.opt
+++ b/gcc/fortran/lang.opt
@@ -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
diff --git a/gcc/fortran/options.c b/gcc/fortran/options.c
index 1010a93844c..dde7ff2f382 100644
--- a/gcc/fortran/options.c
+++ b/gcc/fortran/options.c
@@ -111,6 +111,8 @@ gfc_init_options (unsigned int decoded_options_count,
   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, int value,
       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;
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index cd48d5a67af..7092bc2f153 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -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 +6492,8 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2)
 	&& !(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 +6755,8 @@ alloc_scalar_allocatable_for_assignment (stmtblock_t *block,
   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 +7005,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
     {
       /* 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 +7048,10 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
       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)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a0f64fc1cdc..52ab438c398 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-04-25  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/52196
+	* gfortran.dg/realloc_on_assign_14.f90: New.
+
 2012-04-24  Georg-Johann Lay  <avr@gjlay.de>
 
 	PR testsuite/52641
diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_14.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_14.f90
new file mode 100644
index 00000000000..8474d18622d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_14.f90
@@ -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