re PR fortran/53685 (surprising warns about transfer with explicit character range)

2013-04-22  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/53685
	PR fortran/57022
	* check.c (gfc_calculate_transfer_sizes): Fix for array-valued SOURCE
	expressions.
	* simplify.c (gfc_simplify_sizeof,gfc_simplify_storage_size): Get rid
	of special treatment for EXPR_ARRAY.
	* target-memory.h (gfc_element_size): New prototype.
	* target-memory.c (size_array): Remove.
	(gfc_element_size): New function.
	(gfc_target_expr_size): Modified to always return the full size of the
	expression.


2013-04-22  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/53685
	PR fortran/57022
	* gfortran.dg/transfer_check_4.f90: New.

From-SVN: r198155

7 files changed, 97 insertions, 47 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3361a07..95c448b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,17 @@
+2013-04-22  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/53685
+	PR fortran/57022
+	* check.c (gfc_calculate_transfer_sizes): Fix for array-valued SOURCE
+	expressions.
+	* simplify.c (gfc_simplify_sizeof,gfc_simplify_storage_size): Get rid
+	of special treatment for EXPR_ARRAY.
+	* target-memory.h (gfc_element_size): New prototype.
+	* target-memory.c (size_array): Remove.
+	(gfc_element_size): New function.
+	(gfc_target_expr_size): Modified to always return the full size of the
+	expression.
+
 2013-04-20  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/56907
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 870ca75..e531deb 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -4446,8 +4446,6 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size,
 			      size_t *result_length_p)
 {
   size_t result_elt_size;
-  mpz_t tmp;
-  gfc_expr *mold_element;
 
   if (source->expr_type == EXPR_FUNCTION)
     return false;
@@ -4456,20 +4454,12 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size,
     return false;
 
   /* Calculate the size of the source.  */
-  if (source->expr_type == EXPR_ARRAY
-      && !gfc_array_size (source, &tmp))
-    return false;
-
   *source_size = gfc_target_expr_size (source);
   if (*source_size == 0)
     return false;
 
-  mold_element = mold->expr_type == EXPR_ARRAY
-		 ? gfc_constructor_first (mold->value.constructor)->expr
-		 : mold;
-
   /* Determine the size of the element.  */
-  result_elt_size = gfc_target_expr_size (mold_element);
+  result_elt_size = gfc_element_size (mold);
   if (result_elt_size == 0)
     return false;
 
diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index 5dcbf02..02505db 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -5674,14 +5674,6 @@ gfc_simplify_sizeof (gfc_expr *x)
 				  &x->where);
   mpz_set_si (result->value.integer, gfc_target_expr_size (x));
 
-  /* gfc_target_expr_size already takes the array size for array constructors
-     into account.  */
-  if (x->rank && x->expr_type != EXPR_ARRAY)
-    {
-      mpz_mul (result->value.integer, result->value.integer, array_size);
-      mpz_clear (array_size);
-    }
-
   return result;
 }
 
@@ -5694,7 +5686,6 @@ gfc_simplify_storage_size (gfc_expr *x,
 {
   gfc_expr *result = NULL;
   int k;
-  size_t elt_size;
 
   if (x->ts.type == BT_CLASS || x->ts.deferred)
     return NULL;
@@ -5708,17 +5699,10 @@ gfc_simplify_storage_size (gfc_expr *x,
   if (k == -1)
     return &gfc_bad_expr;
 
-  if (x->expr_type == EXPR_ARRAY)
-    {
-      gfc_constructor *c = gfc_constructor_first (x->value.constructor);
-      elt_size = gfc_target_expr_size (c->expr);
-    }
-  else
-    elt_size = gfc_target_expr_size (x);
-
   result = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind,
 				  &x->where);
-  mpz_set_si (result->value.integer, elt_size);
+
+  mpz_set_si (result->value.integer, gfc_element_size (x));
 
   mpz_mul_ui (result->value.integer, result->value.integer, BITS_PER_UNIT);
   return result;
diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.c
index 7633516..21b44ae 100644
--- a/gcc/fortran/target-memory.c
+++ b/gcc/fortran/target-memory.c
@@ -35,16 +35,6 @@ along with GCC; see the file COPYING3.  If not see
 /* --------------------------------------------------------------- */ 
 /* Calculate the size of an expression.  */
 
-static size_t
-size_array (gfc_expr *e)
-{
-  mpz_t array_size;
-  gfc_constructor *c = gfc_constructor_first (e->value.constructor);
-  size_t elt_size = gfc_target_expr_size (c->expr);
-
-  gfc_array_size (e, &array_size);
-  return (size_t)mpz_get_ui (array_size) * elt_size;
-}
 
 static size_t
 size_integer (int kind)
@@ -82,16 +72,14 @@ size_character (int length, int kind)
 }
 
 
+/* Return the size of a single element of the given expression.
+   Identical to gfc_target_expr_size for scalars.  */
+
 size_t
-gfc_target_expr_size (gfc_expr *e)
+gfc_element_size (gfc_expr *e)
 {
   tree type;
 
-  gcc_assert (e != NULL);
-
-  if (e->expr_type == EXPR_ARRAY)
-    return size_array (e);
-
   switch (e->ts.type)
     {
     case BT_INTEGER:
@@ -133,12 +121,36 @@ gfc_target_expr_size (gfc_expr *e)
 	return size;
       }
     default:
-      gfc_internal_error ("Invalid expression in gfc_target_expr_size.");
+      gfc_internal_error ("Invalid expression in gfc_element_size.");
       return 0;
     }
 }
 
 
+/* Return the size of an expression in its target representation.  */
+
+size_t
+gfc_target_expr_size (gfc_expr *e)
+{
+  mpz_t tmp;
+  size_t asz;
+
+  gcc_assert (e != NULL);
+
+  if (e->rank)
+    {
+      if (gfc_array_size (e, &tmp))
+	asz = mpz_get_ui (tmp);
+      else
+	asz = 0;
+    }
+  else
+    asz = 1;
+
+  return asz * gfc_element_size (e);
+}
+
+
 /* The encode_* functions export a value into a buffer, and 
    return the number of bytes of the buffer that have been
    used.  */
diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h
index 8eebf87..100321a 100644
--- a/gcc/fortran/target-memory.h
+++ b/gcc/fortran/target-memory.h
@@ -24,7 +24,7 @@ along with GCC; see the file COPYING3.  If not see
 /* Convert a BOZ to REAL or COMPLEX.  */
 bool gfc_convert_boz (gfc_expr *, gfc_typespec *);
 
-/* Return the size of an expression in its target representation.  */
+size_t gfc_element_size (gfc_expr *);
 size_t gfc_target_expr_size (gfc_expr *);
 
 /* Write a constant expression in binary form to a target buffer.  */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 055e558..d6be55c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2013-04-22  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/53685
+	PR fortran/57022
+	* gfortran.dg/transfer_check_4.f90: New.
+
 2013-04-22  Marek Polacek  <polacek@redhat.com>
 
 	PR sanitizer/56990
diff --git a/gcc/testsuite/gfortran.dg/transfer_check_4.f90 b/gcc/testsuite/gfortran.dg/transfer_check_4.f90
new file mode 100644
index 0000000..030d345
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_check_4.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-options "-Wall" }
+
+! PR 57022: [4.7/4.8/4.9 Regression] Inappropriate warning for use of TRANSFER with arrays
+! Contributed by William Clodius <wclodius@los-alamos.net>
+
+subroutine transfers (test)
+
+  use, intrinsic :: iso_fortran_env
+  
+  integer, intent(in) :: test
+
+  integer(int8)  :: test8(8)  = 0
+  integer(int16) :: test16(4) = 0
+  integer(int32) :: test32(2) = 0
+  integer(int64) :: test64    = 0
+
+  select case(test)
+  case(0)
+    test64 = transfer(test8, test64)
+  case(1)
+    test64 = transfer(test16, test64)
+  case(2)
+    test64 = transfer(test32, test64)
+  case(3)
+    test8  = transfer(test64, test8, 8)
+  case(4)
+    test16 = transfer(test64, test16, 4)
+  case(5)
+    test32 = transfer(test64, test32, 2)
+  end select
+
+end subroutine
+
+
+! PR 53685: surprising warns about transfer with explicit character range
+! Contributed by Jos de Kloe <kloedej@knmi.nl>
+
+subroutine mytest(byte_array,val)
+  integer, parameter :: r8_ = Selected_Real_Kind(15,307)  ! = real*8
+  character(len=1), dimension(16), intent(in) :: byte_array
+  real(r8_),intent(out) :: val
+  val = transfer(byte_array(1:8),val)    
+end subroutine