Ping - [Patch, fortran] PR27155 && PR27449 - array transfer intrinsic problems
Paul Thomas
paulthomas2@wanadoo.fr
Thu May 25 14:44:00 GMT 2006
Ping!
> :ADDPATCH fortran:
>
> This patch fixes PR27155, where the length of scalar character sources
> was not be read correctly, and hopefully fixes pr27499, where the
> casting of characters to numeric types in the scalarizer assignment
> was not working on 64 bit systems. To fix the former,
> argse->string_length is used and the latter uses an intermediate
> memcpy to avoid the casting.
>
> A testcase is provided for PR27155 but not for PR27449 because it
> shows up an existing testcase.
>
> Regtested on FC5/Athlon1700. On getting the green light from Steve
> and HJ, OK for trunk and 4.1, when it reopens?
These two gentlemen tested the patch and posted their green light to the
PR; ie TRANSFER now works on 64bit machines where alignment is a problem.
I will apply this patch tomorrow morning, unless I hear any objections
in the mean time.
Paul
>
> Paul
>
> 2006-05-21 Paul Thomas <pault@gcc.gnu.org>
>
> PR fortran/27155
> PR fortran/27449
> * trans-intrinsic.c (gfc_conv_intrinsic_array_transfer): Use
> se->string_length
> throughout and use memcpy to populate the expression returned to the
> scalarizer.
>
> 2006-05-21 Paul Thomas <pault@gcc.gnu.org>
>
> PR fortran/27155
> * gfortran.dg/transfer_array_intrinsic_4.f90: New test.
>
>
>
>------------------------------------------------------------------------
>
>Index: gcc/fortran/trans-intrinsic.c
>===================================================================
>*** gcc/fortran/trans-intrinsic.c (revision 113950)
>--- gcc/fortran/trans-intrinsic.c (working copy)
>*************** gfc_conv_intrinsic_array_transfer (gfc_s
>*** 2504,2509 ****
>--- 2504,2510 ----
> tree lower;
> tree stride;
> tree stmt;
>+ tree args;
> gfc_actual_arglist *arg;
> gfc_se argse;
> gfc_ss *ss;
>*************** gfc_conv_intrinsic_array_transfer (gfc_s
>*** 2530,2536 ****
> source = argse.expr;
>
> /* Obtain the source word length. */
>! tmp = size_in_bytes(TREE_TYPE(TREE_TYPE (source)));
> tmp = fold_convert (gfc_array_index_type, tmp);
> }
> else
>--- 2531,2541 ----
> source = argse.expr;
>
> /* Obtain the source word length. */
>! if (arg->expr->ts.type == BT_CHARACTER)
>! tmp = argse.string_length;
>! else
>! tmp = size_in_bytes(TREE_TYPE(TREE_TYPE (source)));
>!
> tmp = fold_convert (gfc_array_index_type, tmp);
> }
> else
>*************** gfc_conv_intrinsic_array_transfer (gfc_s
>*** 2569,2576 ****
> }
>
> /* Obtain the source word length. */
>! tmp = gfc_get_element_type (TREE_TYPE(argse.expr));
>! tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp));
>
> /* Obtain the size of the array in bytes. */
> extent = gfc_create_var (gfc_array_index_type, NULL);
>--- 2574,2588 ----
> }
>
> /* Obtain the source word length. */
>! if (arg->expr->ts.type == BT_CHARACTER)
>! tmp = argse.string_length;
>! else
>! {
>! tmp = gfc_get_element_type (TREE_TYPE(argse.expr));
>! tmp = size_in_bytes (tmp);
>! }
>!
>! tmp = fold_convert (gfc_array_index_type, tmp);
>
> /* Obtain the size of the array in bytes. */
> extent = gfc_create_var (gfc_array_index_type, NULL);
>*************** gfc_conv_intrinsic_array_transfer (gfc_s
>*** 2606,2621 ****
> if (ss == gfc_ss_terminator)
> {
> gfc_conv_expr_reference (&argse, arg->expr);
>! tmp = TREE_TYPE(TREE_TYPE (argse.expr));
>! tmp = fold_convert (gfc_array_index_type, size_in_bytes(tmp));
> }
> else
> {
> gfc_init_se (&argse, NULL);
> argse.want_pointer = 0;
> gfc_conv_expr_descriptor (&argse, arg->expr, ss);
>! tmp = gfc_get_element_type (TREE_TYPE(argse.expr));
>! tmp = fold_convert (gfc_array_index_type, size_in_bytes (tmp));
> }
>
> dest_word_len = gfc_create_var (gfc_array_index_type, NULL);
>--- 2618,2647 ----
> if (ss == gfc_ss_terminator)
> {
> gfc_conv_expr_reference (&argse, arg->expr);
>!
>! if (arg->expr->ts.type == BT_CHARACTER)
>! tmp = argse.string_length;
>! else
>! tmp = size_in_bytes(TREE_TYPE(TREE_TYPE (argse.expr)));
>!
>! tmp = fold_convert (gfc_array_index_type, tmp);
> }
> else
> {
> gfc_init_se (&argse, NULL);
> argse.want_pointer = 0;
> gfc_conv_expr_descriptor (&argse, arg->expr, ss);
>!
>! /* Obtain the source word length. */
>! if (arg->expr->ts.type == BT_CHARACTER)
>! tmp = argse.string_length;
>! else
>! {
>! tmp = gfc_get_element_type (TREE_TYPE(argse.expr));
>! tmp = size_in_bytes (tmp);
>! }
>!
>! tmp = fold_convert (gfc_array_index_type, tmp);
> }
>
> dest_word_len = gfc_create_var (gfc_array_index_type, NULL);
>*************** gfc_conv_intrinsic_array_transfer (gfc_s
>*** 2687,2696 ****
> data field. This is already allocated so set callee_alloc. */
> tmp = gfc_typenode_for_spec (&expr->ts);
> gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
>! info, tmp, false, false, true);
>
> tmp = fold_convert (pvoid_type_node, source);
>! gfc_conv_descriptor_data_set (&se->pre, info->descriptor, tmp);
> se->expr = info->descriptor;
> if (expr->ts.type == BT_CHARACTER)
> se->string_length = dest_word_len;
>--- 2713,2730 ----
> data field. This is already allocated so set callee_alloc. */
> tmp = gfc_typenode_for_spec (&expr->ts);
> gfc_trans_create_temp_array (&se->pre, &se->post, se->loop,
>! info, tmp, false, true, false);
>
>+ /* Use memcpy to do the transfer. */
>+ tmp = gfc_conv_descriptor_data_get (info->descriptor);
>+ args = gfc_chainon_list (NULL_TREE, tmp);
> tmp = fold_convert (pvoid_type_node, source);
>! args = gfc_chainon_list (args, source);
>! args = gfc_chainon_list (args, size_bytes);
>! tmp = built_in_decls[BUILT_IN_MEMCPY];
>! tmp = build_function_call_expr (tmp, args);
>! gfc_add_expr_to_block (&se->pre, tmp);
>!
> se->expr = info->descriptor;
> if (expr->ts.type == BT_CHARACTER)
> se->string_length = dest_word_len;
>
>
>------------------------------------------------------------------------
>
>! { dg-do run }
>! Tests patch for pr27155, where character scalar string_lengths
>! were not correctly translated by the array transfer intrinsic.
>!
>! Contributed by Bo Berggren <bo.berggren@glocalnet.net>
>!
>program trf_test
> implicit none
> character(11) :: s1, s2
> integer(4) :: ia(3)
> integer(1) :: ba(12)
> equivalence (ia, ba)
>
> s1 = 'ABCDEFGHIJK'
> ia = TRANSFER (s1, (/ 0_4 /))
> s2 = TRANSFER(ba + 32_1, s2)
>
> if (s2 .ne. 'abcdefghijk') call abort ()
>
> s1 = 'AB'
> ba = TRANSFER (trim (s1)//' JK' , (/ 0_1 /))
> s2 = TRANSFER(ia, s2)
>
> if (trim (s1)//' JK' .ne. s2) call abort ()
>
>end program trf_test
>
>
More information about the Gcc-patches
mailing list