+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
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)
{
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)
{
array_parameter_size (tmp, expr, size);
return;
}
+
if (sym->attr.allocatable)
{
if (sym->attr.dummy || sym->attr.result)
}
}
+ 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. */
+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
--- /dev/null
+! { 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" } }