OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/41113 (spurious _gfortran_internal_pack)

Browse Source 
2010-02-13  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	PR fortran/41113
	PR fortran/41117
	* gfortran.dg/internal_pack_6.f90: New test.

From-SVN: r156749
This commit is contained in:
Paul Thomas 2010-02-13 12:42:39 +00:00
parent 97d22c8a23
commit 17555e7e36
4 changed files with 108 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
2010-02-13 Paul Thomas <pault@gcc.gnu.org>
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 <jakub@redhat.com>
PR fortran/43030

41
gcc/fortran/trans-array.c
View File

@ -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. */

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2010-02-13 Paul Thomas <pault@gcc.gnu.org>
PR fortran/41113
PR fortran/41117
* gfortran.dg/internal_pack_6.f90: New test.
2010-02-12 Jason Merrill <jason@redhat.com>
PR c++/43054

57
gcc/testsuite/gfortran.dg/internal_pack_6.f90 Normal file
View File

@ -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 <jv244@cam.ac.uk>
!!
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" } }