Commit e361d18d by Janus Weil

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
parent cefb0898
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> 2013-04-20 Tobias Burnus <burnus@net-b.de>
PR fortran/56907 PR fortran/56907
......
...@@ -4446,8 +4446,6 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size, ...@@ -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_length_p)
{ {
size_t result_elt_size; size_t result_elt_size;
mpz_t tmp;
gfc_expr *mold_element;
if (source->expr_type == EXPR_FUNCTION) if (source->expr_type == EXPR_FUNCTION)
return false; return false;
...@@ -4456,20 +4454,12 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size, ...@@ -4456,20 +4454,12 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size,
return false; return false;
/* Calculate the size of the source. */ /* 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); *source_size = gfc_target_expr_size (source);
if (*source_size == 0) if (*source_size == 0)
return false; return false;
mold_element = mold->expr_type == EXPR_ARRAY
? gfc_constructor_first (mold->value.constructor)->expr
: mold;
/* Determine the size of the element. */ /* 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) if (result_elt_size == 0)
return false; return false;
......
...@@ -5674,14 +5674,6 @@ gfc_simplify_sizeof (gfc_expr *x) ...@@ -5674,14 +5674,6 @@ gfc_simplify_sizeof (gfc_expr *x)
&x->where); &x->where);
mpz_set_si (result->value.integer, gfc_target_expr_size (x)); 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; return result;
} }
...@@ -5694,7 +5686,6 @@ gfc_simplify_storage_size (gfc_expr *x, ...@@ -5694,7 +5686,6 @@ gfc_simplify_storage_size (gfc_expr *x,
{ {
gfc_expr *result = NULL; gfc_expr *result = NULL;
int k; int k;
size_t elt_size;
if (x->ts.type == BT_CLASS || x->ts.deferred) if (x->ts.type == BT_CLASS || x->ts.deferred)
return NULL; return NULL;
...@@ -5708,17 +5699,10 @@ gfc_simplify_storage_size (gfc_expr *x, ...@@ -5708,17 +5699,10 @@ gfc_simplify_storage_size (gfc_expr *x,
if (k == -1) if (k == -1)
return &gfc_bad_expr; 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, result = gfc_get_constant_expr (BT_INTEGER, gfc_index_integer_kind,
&x->where); &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); mpz_mul_ui (result->value.integer, result->value.integer, BITS_PER_UNIT);
return result; return result;
......
...@@ -35,16 +35,6 @@ along with GCC; see the file COPYING3. If not see ...@@ -35,16 +35,6 @@ along with GCC; see the file COPYING3. If not see
/* --------------------------------------------------------------- */ /* --------------------------------------------------------------- */
/* Calculate the size of an expression. */ /* 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 static size_t
size_integer (int kind) size_integer (int kind)
...@@ -82,16 +72,14 @@ size_character (int length, 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 size_t
gfc_target_expr_size (gfc_expr *e) gfc_element_size (gfc_expr *e)
{ {
tree type; tree type;
gcc_assert (e != NULL);
if (e->expr_type == EXPR_ARRAY)
return size_array (e);
switch (e->ts.type) switch (e->ts.type)
{ {
case BT_INTEGER: case BT_INTEGER:
...@@ -133,12 +121,36 @@ gfc_target_expr_size (gfc_expr *e) ...@@ -133,12 +121,36 @@ gfc_target_expr_size (gfc_expr *e)
return size; return size;
} }
default: default:
gfc_internal_error ("Invalid expression in gfc_target_expr_size."); gfc_internal_error ("Invalid expression in gfc_element_size.");
return 0; 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 /* The encode_* functions export a value into a buffer, and
return the number of bytes of the buffer that have been return the number of bytes of the buffer that have been
used. */ used. */
......
...@@ -24,7 +24,7 @@ along with GCC; see the file COPYING3. If not see ...@@ -24,7 +24,7 @@ along with GCC; see the file COPYING3. If not see
/* Convert a BOZ to REAL or COMPLEX. */ /* Convert a BOZ to REAL or COMPLEX. */
bool gfc_convert_boz (gfc_expr *, gfc_typespec *); 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 *); size_t gfc_target_expr_size (gfc_expr *);
/* Write a constant expression in binary form to a target buffer. */ /* Write a constant expression in binary form to a target buffer. */
......
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> 2013-04-22 Marek Polacek <polacek@redhat.com>
PR sanitizer/56990 PR sanitizer/56990
......
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment