From 2542496c7022185de67a2098e93f966c610835c3 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Tue, 2 Mar 2010 11:58:02 +0000 Subject: [PATCH] re PR fortran/43180 (Bad results without temporary copy of intent(in) argument) 2010-03-02 Paul Thomas PR fortran/43180 * trans-array.c (gfc_conv_array_parameter): A full array of derived type need not be restricted to a symbol without an array spec to use the call to gfc_conv_expr_descriptor. PR fortran/43173 * trans-array.c (gfc_conv_array_parameter): Contiguous refs to allocatable arrays do not need temporaries. 2010-03-02 Paul Thomas PR fortran/43180 * gfortran.dg/internal_pack_10.f90: New test. PR fortran/43173 * gfortran.dg/internal_pack_11.f90: New test. From-SVN: r157163 --- gcc/fortran/ChangeLog | 11 +++++ gcc/fortran/trans-array.c | 30 +++++++------- gcc/testsuite/ChangeLog | 8 ++++ .../gfortran.dg/internal_pack_10.f90 | 41 +++++++++++++++++++ .../gfortran.dg/internal_pack_11.f90 | 18 ++++++++ 5 files changed, 92 insertions(+), 16 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/internal_pack_10.f90 create mode 100644 gcc/testsuite/gfortran.dg/internal_pack_11.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 0c802b662de..12c71921e78 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2010-03-02 Paul Thomas + + PR fortran/43180 + * trans-array.c (gfc_conv_array_parameter): A full array of + derived type need not be restricted to a symbol without an + array spec to use the call to gfc_conv_expr_descriptor. + + PR fortran/43173 + * trans-array.c (gfc_conv_array_parameter): Contiguous refs to + allocatable arrays do not need temporaries. + 2010-03-01 Tobias Burnus PR fortran/43199 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 2ea978d0ece..c8728899c6d 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5472,6 +5472,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77, bool this_array_result; bool contiguous; bool no_pack; + bool array_constructor; + bool good_allocatable; gfc_symbol *sym; stmtblock_t block; gfc_ref *ref; @@ -5513,7 +5515,7 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77, if (sym->ts.type == BT_CHARACTER) se->string_length = sym->ts.u.cl->backend_decl; - if (sym->ts.type == BT_DERIVED && !sym->as) + if (sym->ts.type == BT_DERIVED) { gfc_conv_expr_descriptor (se, expr, ss); se->expr = gfc_conv_array_data (se->expr); @@ -5550,8 +5552,8 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77, } } - /* There is no need to pack and unpack the array, if it is an array - constructor or contiguous and not deferred or assumed shape. */ + /* There is no need to pack and unpack the array, if it is contiguous + and not deferred or assumed shape. */ no_pack = ((sym && sym->as && !sym->attr.pointer && sym->as->type != AS_DEFERRED @@ -5561,21 +5563,17 @@ gfc_conv_array_parameter (gfc_se * se, gfc_expr * expr, gfc_ss * ss, bool g77, && ref->u.ar.as->type != AS_DEFERRED && ref->u.ar.as->type != AS_ASSUMED_SHAPE)); - no_pack = g77 && !this_array_result - && (expr->expr_type == EXPR_ARRAY || (contiguous && no_pack)); + no_pack = g77 && !this_array_result && contiguous && no_pack; - if (no_pack) - { - 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; - } + /* Array constructors are always contiguous and do not need packing. */ + array_constructor = g77 && !this_array_result && expr->expr_type == EXPR_ARRAY; - if (expr->expr_type == EXPR_ARRAY && g77) + /* Same is true of contiguous sections from allocatable variables. */ + good_allocatable = (g77 && !this_array_result && contiguous + && expr->symtree + && expr->symtree->n.sym->attr.allocatable); + + if (no_pack || array_constructor || good_allocatable) { gfc_conv_expr_descriptor (se, expr, ss); if (expr->ts.type == BT_CHARACTER) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 63ceb9a4add..2b0b742a082 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2010-03-02 Paul Thomas + + PR fortran/43180 + * gfortran.dg/internal_pack_10.f90: New test. + + PR fortran/43173 + * gfortran.dg/internal_pack_11.f90: New test. + 2010-03-02 Reza Yazdani PR middle-end/42640 diff --git a/gcc/testsuite/gfortran.dg/internal_pack_10.f90 b/gcc/testsuite/gfortran.dg/internal_pack_10.f90 new file mode 100644 index 00000000000..8d972f44c18 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/internal_pack_10.f90 @@ -0,0 +1,41 @@ +! { dg-do run } +! Test the fix for PR43180, in which patch which reduced the use of +! internal_pack/unpack messed up the passing of ru(1)%c as the actual +! argument at line 23 in this testcase. +! +! Contributed by Harald Anlauf +! further reduced by Tobias Burnus +! +module mo_obs_rules + type t_set + integer :: use = 42 + end type t_set + type t_rules + character(len=40) :: comment + type(t_set) :: c (1) + end type t_rules + type (t_rules), save :: ru (1) +contains + subroutine get_rule (c) + type(t_set) :: c (:) + ru(1)%c(:)%use = 99 + if (any (c(:)%use .ne. 42)) call abort + call set_set_v (ru(1)%c, c) + if (any (c(:)%use .ne. 99)) call abort + contains + subroutine set_set_v (src, dst) + type(t_set), intent(in) :: src(1) + type(t_set), intent(inout) :: dst(1) + if (any (src%use .ne. 99)) call abort + if (any (dst%use .ne. 42)) call abort + dst = src + end subroutine set_set_v + end subroutine get_rule +end module mo_obs_rules + +program test + use mo_obs_rules + type(t_set) :: c (1) + call get_rule (c) +end program test +! { dg-final { cleanup-modules "mo_obs_rules" } } diff --git a/gcc/testsuite/gfortran.dg/internal_pack_11.f90 b/gcc/testsuite/gfortran.dg/internal_pack_11.f90 new file mode 100644 index 00000000000..8f573b4fd95 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/internal_pack_11.f90 @@ -0,0 +1,18 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! Test the fix for PR43173, where unnecessary calls to internal_pack/unpack +! were being produced below. These references are contiguous and so do not +! need a temporary. +! +! Contributed Tobias Burnus +! + REAL, allocatable :: ot(:) + integer :: time_steps + + call foo (ot) ! OK, no temporary + call foo (ot(0:5:1)) ! Was an unnecessary temporary + call foo (ot(0:time_steps)) ! Was an unnecessary temporary + end +! { dg-final { scan-tree-dump-times "unpack" 0 "original" } } +! { dg-final { cleanup-tree-dump "original" } }