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:
Paul Thomas 2010-03-02 11:58:02 +00:00
parent 61226dc8a6
commit 2542496c70
5 changed files with 92 additions and 16 deletions

View File

@ -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

View File

@ -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)

View File

@ -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

View 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" } }

View 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" } }