re PR fortran/43180 (Bad results without temporary copy of intent(in) argument)
2010-03-02 Paul Thomas <pault@gcc.gnu.org> 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 <pault@gcc.gnu.org> 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
This commit is contained in:
parent
61226dc8a6
commit
2542496c70
@ -1,3 +1,14 @@
|
||||
2010-03-02 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
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 <burnus@net-b.de>
|
||||
|
||||
PR fortran/43199
|
||||
|
@ -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)
|
||||
|
@ -1,3 +1,11 @@
|
||||
2010-03-02 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
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 <reza.yazdani@amd.com>
|
||||
|
||||
PR middle-end/42640
|
||||
|
41
gcc/testsuite/gfortran.dg/internal_pack_10.f90
Normal file
41
gcc/testsuite/gfortran.dg/internal_pack_10.f90
Normal file
@ -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 <anlauf@gmx.de>
|
||||
! further reduced by Tobias Burnus <burnus@gcc.gnu.org>
|
||||
!
|
||||
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" } }
|
18
gcc/testsuite/gfortran.dg/internal_pack_11.f90
Normal file
18
gcc/testsuite/gfortran.dg/internal_pack_11.f90
Normal file
@ -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 <burnus@gcc.gnu.org>
|
||||
!
|
||||
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" } }
|
Loading…
Reference in New Issue
Block a user