From 1efd1a2f43a41b4467571194110ee1a921b2124d Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Thu, 22 Mar 2007 18:37:16 +0000 Subject: [PATCH] re PR fortran/31193 ([4.2 only] ICE on non-constant character tranfert) 2006-03-22 Paul Thomas 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 PR fortran/31193 * gfortran.dg/transfer_array_intrinsic_3.f90: New test. From-SVN: r123131 --- gcc/fortran/ChangeLog | 12 ++++ gcc/fortran/trans-intrinsic.c | 72 +++++++++---------- gcc/testsuite/ChangeLog | 5 ++ .../transfer_array_intrinsic_3.f90 | 36 ++++++++++ 4 files changed, 88 insertions(+), 37 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/transfer_array_intrinsic_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c32304bf952..4e366aa0274 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,15 @@ +2006-03-22 Paul Thomas + + 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 PR fortran/20897 diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index 58c4131eea7..4465030ab5e 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index d993a15c1f6..6f551d028dc 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2006-03-22 Paul Thomas + + PR fortran/31193 + * gfortran.dg/transfer_array_intrinsic_3.f90: New test. + 2007-03-22 Tobias Schlüter PR fortran/20897 diff --git a/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_3.f90 b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_3.f90 new file mode 100644 index 00000000000..b97e840a468 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_3.f90 @@ -0,0 +1,36 @@ +! { 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 +! +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 -- 2.30.2