From 7544787a011311bbc7b5d80ae73505553cb082e2 Mon Sep 17 00:00:00 2001 From: pault Date: Fri, 26 May 2006 05:09:18 +0000 Subject: [PATCH] 2006-05-26 Paul Thomas PR fortran/27709 * resolve.c (find_array_spec): Add gfc_symbol, derived, and use to track repeated component references. 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. (gfc_size_in_bytes): New function. 2006-05-26 Paul Thomas PR fortran/27709 * gfortran.dg/spec_expr_4.f90: New test. PR fortran/27155 * gfortran.dg/transfer_array_intrinsic_4.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@114127 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 13 ++++++ gcc/fortran/resolve.c | 16 ++++++- gcc/fortran/trans-intrinsic.c | 53 ++++++++++++++++++---- gcc/testsuite/ChangeLog | 8 ++++ gcc/testsuite/gfortran.dg/spec_expr_4.f90 | 33 ++++++++++++++ .../gfortran.dg/transfer_array_intrinsic_4.f90 | 27 +++++++++++ 6 files changed, 138 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/spec_expr_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/transfer_array_intrinsic_4.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7f80e376e67..0117eb66bbf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,16 @@ +2006-05-26 Paul Thomas + + PR fortran/27709 + * resolve.c (find_array_spec): Add gfc_symbol, derived, and + use to track repeated component references. + + 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. + (gfc_size_in_bytes): New function. + 2006-05-21 Paul Thomas PR fortran/27613 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 0affecc06a2..660f1c0ef80 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -2285,9 +2285,11 @@ find_array_spec (gfc_expr * e) { gfc_array_spec *as; gfc_component *c; + gfc_symbol *derived; gfc_ref *ref; as = e->symtree->n.sym->as; + derived = NULL; for (ref = e->ref; ref; ref = ref->next) switch (ref->type) @@ -2301,9 +2303,19 @@ find_array_spec (gfc_expr * e) break; case REF_COMPONENT: - for (c = e->symtree->n.sym->ts.derived->components; c; c = c->next) + if (derived == NULL) + derived = e->symtree->n.sym->ts.derived; + + c = derived->components; + + for (; c; c = c->next) if (c == ref->u.c.component) - break; + { + /* Track the sequence of component references. */ + if (c->ts.type == BT_DERIVED) + derived = c->ts.derived; + break; + } if (c == NULL) gfc_internal_error ("find_array_spec(): Component not found"); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index eb5286e7a6a..1d1858ca807 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -2482,6 +2482,30 @@ 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: @@ -2504,6 +2528,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr) tree lower; tree stride; tree stmt; + tree args; gfc_actual_arglist *arg; gfc_se argse; gfc_ss *ss; @@ -2530,8 +2555,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr) 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); + tmp = gfc_size_in_bytes (&argse, arg->expr); } else { @@ -2569,8 +2593,7 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr) } /* 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)); + tmp = gfc_size_in_bytes (&argse, arg->expr); /* Obtain the size of the array in bytes. */ extent = gfc_create_var (gfc_array_index_type, NULL); @@ -2606,16 +2629,18 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr) 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)); + + /* Obtain the source word length. */ + tmp = gfc_size_in_bytes (&argse, arg->expr); } 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)); + + /* Obtain the source word length. */ + tmp = gfc_size_in_bytes (&argse, arg->expr); } dest_word_len = gfc_create_var (gfc_array_index_type, NULL); @@ -2687,10 +2712,18 @@ gfc_conv_intrinsic_array_transfer (gfc_se * se, gfc_expr * expr) 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); + 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); - gfc_conv_descriptor_data_set (&se->pre, info->descriptor, tmp); + 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 78fa87aba49..c55a9ecfb34 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2006-05-26 Paul Thomas + + PR fortran/27709 + * gfortran.dg/spec_expr_4.f90: New test. + + PR fortran/27155 + * gfortran.dg/transfer_array_intrinsic_4.f90: New test. + 2006-05-25 Mark Mitchell PR c++/20103 diff --git a/gcc/testsuite/gfortran.dg/spec_expr_4.f90 b/gcc/testsuite/gfortran.dg/spec_expr_4.f90 new file mode 100644 index 00000000000..7b2d5b6be13 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/spec_expr_4.f90 @@ -0,0 +1,33 @@ +! { dg-do compile } +! Tests the fix for PR27709 in which the specification expression on +! line 22 was not resolved because of the multiple component references. +! +! Contributed by David Ham +! +module elements + implicit none + type element_type + type(ele_numbering_type), pointer :: numbering + end type element_type + type ele_numbering_type + integer, dimension(:,:), pointer :: number2count + end type ele_numbering_type +end module elements +module global_numbering + use elements + implicit none +contains + function element_local_coords(element) result (coords) + type(element_type), intent(in) :: element + real, dimension(size(element%numbering%number2count, 1)) :: coords + coords=0.0 + end function element_local_coords +end module global_numbering + + use global_numbering + type (element_type) :: e + type (ele_numbering_type), target :: ent + allocate (ent%number2count (2,2)) + e%numbering => ent + print *, element_local_coords (e) +end diff --git a/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_4.f90 b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_4.f90 new file mode 100644 index 00000000000..3a929a81446 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transfer_array_intrinsic_4.f90 @@ -0,0 +1,27 @@ +! { dg-do run } +! { dg-options "-std=gnu" } +! Tests patch for pr27155, where character scalar string_lengths +! were not correctly translated by the array transfer intrinsic. +! +! Contributed by Bo Berggren +! +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 -- 2.11.0