Skip to content

R
riscv-gcc-1
Commit 1efd1a2f by Paul Thomas
Options

re PR fortran/31193 ([4.2 only] ICE on non-constant character tranfert) 

2006-03-22  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31193
	* trans-intrinsic.c (gfc_size_in_bytes): Remove function.
	(gfc_conv_intrinsic_array_transfer): Remove calls to previous.
	Explicitly extract TREE_TYPEs for source and mold.  Use these
	to calculate length of source and mold, except for characters,
	where the se string_length is used.  For mold, the TREE_TYPE is
	recalculated using gfc_get_character_type_len so that the
	result is correctly cast for character literals and substrings.
	Do not use gfc_typenode_for_spec for the final cast.

2006-03-22  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31193
	* gfortran.dg/transfer_array_intrinsic_3.f90: New test.

From-SVN: r123131
parent 803f183a
Showing with 88 additions and 37 deletions
gcc/fortran/ChangeLog
2006-03-22 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31193
* trans-intrinsic.c (gfc_size_in_bytes): Remove function.
(gfc_conv_intrinsic_array_transfer): Remove calls to previous.
Explicitly extract TREE_TYPEs for source and mold. Use these
to calculate length of source and mold, except for characters,
where the se string_length is used. For mold, the TREE_TYPE is
recalculated using gfc_get_character_type_len so that the
result is correctly cast for character literals and substrings.
Do not use gfc_typenode_for_spec for the final cast.
2007-03-22 Tobias Schlüter <tobi@gcc.gnu.org>
PR fortran/20897
......
gcc/fortran/trans-intrinsic.c
......@@ -2790,30 +2790,6 @@ gfc_conv_intrinsic_adjust (gfc_se * se, gfc_expr * expr, tree fndecl)
}
/* A helper function for gfc_conv_intrinsic_array_transfer to compute
the size of tree expressions in bytes. */
static tree
gfc_size_in_bytes (gfc_se *se, gfc_expr *e)
{
tree tmp;
if (e->ts.type == BT_CHARACTER)
tmp = se->string_length;
else
{
if (e->rank)
{
tmp = gfc_get_element_type (TREE_TYPE (se->expr));
tmp = size_in_bytes (tmp);
}
else
tmp = size_in_bytes (TREE_TYPE (TREE_TYPE (se->expr)));
}
return fold_convert (gfc_array_index_type, tmp);
}
/* Array transfer statement.
DEST(1:N) = TRANSFER (SOURCE, MOLD[, SIZE])
where:
......@@ -2828,7 +2804,9 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
tree tmp;
tree extent;
tree source;
tree source_type;
tree source_bytes;
tree mold_type;
tree dest_word_len;
tree size_words;
tree size_bytes;
......@@ -2861,8 +2839,14 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
gfc_conv_expr_reference (&argse, arg->expr);
source = argse.expr;
source_type = TREE_TYPE (build_fold_indirect_ref (argse.expr));
/* Obtain the source word length. */
tmp = gfc_size_in_bytes (&argse, arg->expr);
if (arg->expr->ts.type == BT_CHARACTER)
tmp = fold_convert (gfc_array_index_type, argse.string_length);
else
tmp = fold_convert (gfc_array_index_type,
size_in_bytes (source_type));
}
else
{
......@@ -2870,6 +2854,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
argse.want_pointer = 0;
gfc_conv_expr_descriptor (&argse, arg->expr, ss);
source = gfc_conv_descriptor_data_get (argse.expr);
source_type = gfc_get_element_type (TREE_TYPE (argse.expr));
/* Repack the source if not a full variable array. */
if (!(arg->expr->expr_type == EXPR_VARIABLE
......@@ -2898,7 +2883,11 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
}
/* Obtain the source word length. */
tmp = gfc_size_in_bytes (&argse, arg->expr);
if (arg->expr->ts.type == BT_CHARACTER)
tmp = fold_convert (gfc_array_index_type, argse.string_length);
else
tmp = fold_convert (gfc_array_index_type,
size_in_bytes (source_type));
/* Obtain the size of the array in bytes. */
extent = gfc_create_var (gfc_array_index_type, NULL);
......@@ -2924,7 +2913,8 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
gfc_add_block_to_block (&se->pre, &argse.pre);
gfc_add_block_to_block (&se->post, &argse.post);
/* Now convert MOLD. The sole output is:
/* Now convert MOLD. The outputs are:
mold_type = the TREE type of MOLD
dest_word_len = destination word length in bytes. */
arg = arg->next;
......@@ -2934,20 +2924,25 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
if (ss == gfc_ss_terminator)
{
gfc_conv_expr_reference (&argse, arg->expr);
/* Obtain the source word length. */
tmp = gfc_size_in_bytes (&argse, arg->expr);
mold_type = TREE_TYPE (build_fold_indirect_ref (argse.expr));
}
else
{
gfc_init_se (&argse, NULL);
argse.want_pointer = 0;
gfc_conv_expr_descriptor (&argse, arg->expr, ss);
/* Obtain the source word length. */
tmp = gfc_size_in_bytes (&argse, arg->expr);
mold_type = gfc_get_element_type (TREE_TYPE (argse.expr));
}
if (arg->expr->ts.type == BT_CHARACTER)
{
tmp = fold_convert (gfc_array_index_type, argse.string_length);
mold_type = gfc_get_character_type_len (arg->expr->ts.kind, tmp);
}
else
tmp = fold_convert (gfc_array_index_type,
size_in_bytes (mold_type));
dest_word_len = gfc_create_var (gfc_array_index_type, NULL);
gfc_add_modify_expr (&se->pre, dest_word_len, tmp);
......@@ -3016,15 +3011,18 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr)
/* Build a destination descriptor, using the pointer, source, as the
data field. This is already allocated so set callee_alloc.
FIXME callee_alloc is not set! */
tmp = gfc_typenode_for_spec (&expr->ts);
gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
info, tmp, false, true, false);
info, mold_type, false, true, false);
/* Cast the pointer to the result. */
tmp = gfc_conv_descriptor_data_get (info->descriptor);
tmp = fold_convert (pvoid_type_node, tmp);
/* Use memcpy to do the transfer. */
tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY],
3,
gfc_conv_descriptor_data_get (info->descriptor),
tmp,
fold_convert (pvoid_type_node, source),
size_bytes);
gfc_add_expr_to_block (&se->pre, tmp);
......
gcc/testsuite/ChangeLog
2006-03-22 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31193
* gfortran.dg/transfer_array_intrinsic_3.f90: New test.
2007-03-22 Tobias Schlter <tobi@gcc.gnu.org>
PR fortran/20897
gcc/testsuite/gfortran.dg/transfer_array_intrinsic_3.f90 0 → 100644
! { dg-do run }
! Tests fix for PR31193, in which the character length for MOLD in
! case 1 below was not being translated correctly for character
! constants and an ICE ensued. The further cases are either checks
! or new bugs that were found in the course of development cases 3 & 5.
!
! Contributed by Brooks Moses <brooks@gcc.gnu.org>
!
function NumOccurances (string, chr, isel) result(n)
character(*),intent(in) :: string
character(1),intent(in) :: chr
integer :: isel
!
! return number of occurances of character in given string
!
select case (isel)
case (1)
n=count(transfer(string, char(1), len(string))==chr)
case (2)
n=count(transfer(string, chr, len(string))==chr)
case (3)
n=count(transfer(string, "a", len(string))==chr)
case (4)
n=count(transfer(string, (/"a","b"/), len(string))==chr)
case (5)
n=count(transfer(string, string(1:1), len(string))==chr)
end select
return
end
if (NumOccurances("abacadae", "a", 1) .ne. 4) call abort ()
if (NumOccurances("abacadae", "a", 2) .ne. 4) call abort ()
if (NumOccurances("abacadae", "a", 3) .ne. 4) call abort ()
if (NumOccurances("abacadae", "a", 4) .ne. 4) call abort ()
if (NumOccurances("abacadae", "a", 5) .ne. 4) call abort ()
end
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