From: Paul Thomas Date: Sat, 13 Feb 2010 12:42:39 +0000 (+0000) Subject: re PR fortran/41113 (spurious _gfortran_internal_pack) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=17555e7e367ff3b334e7eae368e5c3a9b4485579;p=gcc.git re PR fortran/41113 (spurious _gfortran_internal_pack) 2010-02-13 Paul Thomas PR fortran/41113 PR fortran/41117 * trans-array.c (gfc_conv_array_parameter): Use gfc_full_array_ref_p to detect full and contiguous variable arrays. Full array components and contiguous arrays do not need internal_pack and internal_unpack. 2010-02-13 Paul Thomas PR fortran/41113 PR fortran/41117 * gfortran.dg/internal_pack_6.f90: New test. From-SVN: r156749 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index af6dd52a7fa..0c1066d95d4 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2010-02-13 Paul Thomas + + PR fortran/41113 + PR fortran/41117 + * trans-array.c (gfc_conv_array_parameter): Use + gfc_full_array_ref_p to detect full and contiguous variable + arrays. Full array components and contiguous arrays do not need + internal_pack and internal_unpack. + 2010-02-11 Jakub Jelinek PR fortran/43030 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index d512da4db6b..ae39aed1c58 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5468,17 +5468,27 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, tree tmp = NULL_TREE; tree stmt; tree parent = DECL_CONTEXT (current_function_decl); - bool full_array_var, this_array_result; + bool full_array_var; + bool this_array_result; + bool contiguous; gfc_symbol *sym; stmtblock_t block; + gfc_ref *ref; + + for (ref = expr->ref; ref; ref = ref->next) + if (ref->next == NULL) + break; + + full_array_var = false; + contiguous = false; + + if (expr->expr_type == EXPR_VARIABLE && ref) + full_array_var = gfc_full_array_ref_p (ref, &contiguous); - full_array_var = (expr->expr_type == EXPR_VARIABLE - && expr->ref->type == REF_ARRAY - && expr->ref->u.ar.type == AR_FULL); sym = full_array_var ? expr->symtree->n.sym : NULL; /* The symbol should have an array specification. */ - gcc_assert (!sym || sym->as); + gcc_assert (!sym || sym->as || ref->u.ar.as); if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_CHARACTER) { @@ -5501,6 +5511,14 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, if (sym->ts.type == BT_CHARACTER) se->string_length = sym->ts.u.cl->backend_decl; + + if (sym->ts.type == BT_DERIVED && !sym->as) + { + gfc_conv_expr_descriptor (se, expr, ss); + se->expr = gfc_conv_array_data (se->expr); + return; + } + if (!sym->attr.pointer && sym->as->type != AS_ASSUMED_SHAPE && !sym->attr.allocatable) { @@ -5514,6 +5532,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, array_parameter_size (tmp, expr, size); return; } + if (sym->attr.allocatable) { if (sym->attr.dummy || sym->attr.result) @@ -5528,6 +5547,18 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, int g77, } } + if (contiguous && g77 && !this_array_result + && !expr->symtree->n.sym->attr.dummy) + { + gfc_conv_expr_descriptor (se, expr, ss); + if (expr->ts.type == BT_CHARACTER) + se->string_length = expr->ts.u.cl->backend_decl; + if (size) + array_parameter_size (se->expr, expr, size); + se->expr = gfc_conv_array_data (se->expr); + return; + } + if (this_array_result) { /* Result of the enclosing function. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9ec83bf382e..157d79cb4c8 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-02-13 Paul Thomas + + PR fortran/41113 + PR fortran/41117 + * gfortran.dg/internal_pack_6.f90: New test. + 2010-02-12 Jason Merrill PR c++/43054 diff --git a/gcc/testsuite/gfortran.dg/internal_pack_6.f90 b/gcc/testsuite/gfortran.dg/internal_pack_6.f90 new file mode 100644 index 00000000000..c02f7c9bec5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/internal_pack_6.f90 @@ -0,0 +1,57 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR41113 and PR41117, in which unnecessary calls +! to internal_pack and internal_unpack were being generated. +! +! Contributed by Joost VandeVondele +!! +MODULE M1 + TYPE T1 + REAL :: data(10) = [(i, i = 1, 10)] + END TYPE T1 +CONTAINS + SUBROUTINE S1(data, i, chksum) + REAL, DIMENSION(*) :: data + integer :: i, j + real :: subsum, chksum + subsum = 0 + do j = 1, i + subsum = subsum + data(j) + end do + if (abs(subsum - chksum) > 1e-6) call abort + END SUBROUTINE S1 +END MODULE + +SUBROUTINE S2 + use m1 + TYPE(T1) :: d + + real :: data1(10) = [(i, i = 1, 10)] + REAL :: data(-4:5,-4:5) = reshape ([(real(i), i = 1, 100)], [10,10]) + +! PR41113 + CALL S1(d%data, 10, sum (d%data)) + CALL S1(data1, 10, sum (data1)) + +! PR41117 + DO i=-4,5 + CALL S1(data(:,i), 10, sum (data(:,i))) + ENDDO +! Being non-contiguous, this is the only time that _internal_pack is called + DO i=-4,5 + CALL S1(data(-2:,i), 8, sum (data(-2:,i))) + ENDDO + DO i=-4,4 + CALL S1(data(:,i:i+1), 20, sum (reshape (data(:,i:i+1), [20]))) + ENDDO + DO i=-4,5 + CALL S1(data(2,i), 1, data(2,i)) + ENDDO +END SUBROUTINE S2 + + call s2 +end +! { dg-final { cleanup-modules "M1" } } +! { dg-final { scan-tree-dump-times "_gfortran_internal_pack" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } }