Index: gcc/fortran/check.c =================================================================== --- gcc/fortran/check.c (revision 198144) +++ gcc/fortran/check.c (working copy) @@ -4446,8 +4446,6 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gf 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, gf 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; Index: gcc/fortran/simplify.c =================================================================== --- gcc/fortran/simplify.c (revision 198144) +++ gcc/fortran/simplify.c (working copy) @@ -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,18 +5699,11 @@ 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; } Index: gcc/fortran/target-memory.c =================================================================== --- gcc/fortran/target-memory.c (revision 198144) +++ gcc/fortran/target-memory.c (working copy) @@ -35,17 +35,7 @@ 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 @@ size_t 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. */ Index: gcc/fortran/target-memory.h =================================================================== --- gcc/fortran/target-memory.h (revision 198144) +++ gcc/fortran/target-memory.h (working copy) @@ -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. */ Index: gcc/testsuite/gfortran.dg/transfer_check_4.f90 =================================================================== --- gcc/testsuite/gfortran.dg/transfer_check_4.f90 (revision 0) +++ gcc/testsuite/gfortran.dg/transfer_check_4.f90 (working copy) @@ -0,0 +1,50 @@ +! { 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 + +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 + +subroutine assumed_rank (a) + integer, intent(in) :: a(..) + integer :: c(1:4) + c = transfer(a,c,4) +end subroutine + + +! PR 53685: surprising warns about transfer with explicit character range +! Contributed by Jos de Kloe + +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