:ADDPATCH fortran:
This:
module gd_calc
type calc_signal_type
integer :: dummy
logical :: used
integer :: signal_number
end type
contains
subroutine activate_gd_calcs (used, outputs)
logical, intent(inout) :: used(:)
type(calc_signal_type), pointer :: outputs(:)
outputs%used = used(outputs%signal_number)
return
end subroutine activate_gd_calcs
end module gd_calc
gives, compiling without -O,
: internal compiler error: in emit_move_insn, at expr.c:3236
The patch below fixes the problem by enclosing the expression for the
array
reference outputs%signal_number in parentheses(You can verify that
this does
the right thing by doing it explicitly in the fortran.). This turns the
temporary, used in the scalarizer loop, from the structure into its
integer
component, signal_number. I did contemplate doing clever stuff with
tree_ssa,
a bit further down stream, but this is conceptually much simpler and
works.
Regtested on FC5/Athlon1700 - OK for trunk and, with the traditional
delay, 4.1?
Paul
2006-05-06 Paul Thomas <pault@gcc.gnu.org>
PR fortran/PR24711
* matchexp.c (gfc_get_parentheses): New function.
(match_primary): Remove inline code and call above.
* gfortran.h: Provide prototype for gfc_get_parentheses.
* resolve.c (resolve_array_ref): Call the above, when start is a
derived type variable array reference.
2006-05-06 Paul Thomas <pault@gcc.gnu.org>
PR fortran/PR24711
* gfortran.dg/derived_comp_array_ref_1.f90: New test.
------------------------------------------------------------------------
Index: gcc/fortran/matchexp.c
===================================================================
*** gcc/fortran/matchexp.c (revision 113576)
--- gcc/fortran/matchexp.c (working copy)
*************** next_operator (gfc_intrinsic_op t)
*** 123,128 ****
--- 123,148 ----
}
+ /* Call the INTRINSIC_PARENTHESES function. This is both
+ used explicitly, as below, or by resolve.c to generate
+ temporaries. */
+ gfc_expr *
+ gfc_get_parentheses (gfc_expr *e)
+ {
+ gfc_expr *e2;
+
+ e2 = gfc_get_expr();
+ e2->expr_type = EXPR_OP;
+ e2->ts = e->ts;
+ e2->rank = e->rank;
+ e2->where = e->where;
+ e2->value.op.operator = INTRINSIC_PARENTHESES;
+ e2->value.op.op1 = e;
+ e2->value.op.op2 = NULL;
+ return e2;
+ }
+
+
/* Match a primary expression. */
static match
*************** match_primary (gfc_expr ** result)
*** 167,184 ****
if(!gfc_numeric_ts(&e->ts))
*result = e;
else
! {
! gfc_expr *e2 = gfc_get_expr();
!
! e2->expr_type = EXPR_OP;
! e2->ts = e->ts;
! e2->rank = e->rank;
! e2->where = where;
! e2->value.op.operator = INTRINSIC_PARENTHESES;
! e2->value.op.op1 = e;
! e2->value.op.op2 = NULL;
! *result = e2;
! }
if (m != MATCH_YES)
{
--- 187,193 ----
if(!gfc_numeric_ts(&e->ts))
*result = e;
else
! *result = gfc_get_parentheses (e);
if (m != MATCH_YES)
{
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 113576)
--- gcc/fortran/gfortran.h (working copy)
*************** void gfc_free_equiv (gfc_equiv *);
*** 1941,1946 ****
--- 1941,1949 ----
void gfc_free_data (gfc_data *);
void gfc_free_case_list (gfc_case *);
+ /* matchexp.c -- FIXME too? */
+ gfc_expr *gfc_get_parentheses (gfc_expr *);
+
/* openmp.c */
void gfc_free_omp_clauses (gfc_omp_clauses *);
void gfc_resolve_omp_directive (gfc_code *, gfc_namespace *);
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 113576)
--- gcc/fortran/resolve.c (working copy)
*************** static try
*** 2284,2289 ****
--- 2284,2290 ----
resolve_array_ref (gfc_array_ref * ar)
{
int i, check_scalar;
+ gfc_expr *e;
for (i = 0; i < ar->dimen; i++)
{
*************** resolve_array_ref (gfc_array_ref * ar)
*** 2296,2303 ****
if (gfc_resolve_index (ar->stride[i], check_scalar) == FAILURE)
return FAILURE;
if (ar->dimen_type[i] == DIMEN_UNKNOWN)
! switch (ar->start[i]->rank)
{
case 0:
ar->dimen_type[i] = DIMEN_ELEMENT;
--- 2297,2306 ----
if (gfc_resolve_index (ar->stride[i], check_scalar) == FAILURE)
return FAILURE;
+ e = ar->start[i];
+
if (ar->dimen_type[i] == DIMEN_UNKNOWN)
! switch (e->rank)
{
case 0:
ar->dimen_type[i] = DIMEN_ELEMENT;
*************** resolve_array_ref (gfc_array_ref * ar)
*** 2305,2315 ****
case 1:
ar->dimen_type[i] = DIMEN_VECTOR;
break;
default:
gfc_error ("Array index at %L is an array of rank %d",
! &ar->c_where[i], ar->start[i]->rank);
return FAILURE;
}
}
--- 2308,2321 ----
case 1:
ar->dimen_type[i] = DIMEN_VECTOR;
+ if (e->expr_type == EXPR_VARIABLE
+ && e->symtree->n.sym->ts.type == BT_DERIVED)
+ ar->start[i] = gfc_get_parentheses (e);
break;
default:
gfc_error ("Array index at %L is an array of rank %d",
! &ar->c_where[i], e->rank);
return FAILURE;
}
}
------------------------------------------------------------------------
! { dg-do run }
! Tests the fix for PR27411, in which the array reference on line
! 18 caused an ICE because the derived type, rather than its integer
! component, was appearing in the index expression.
!
! Contributed by Richard Maine <1fhcwee02@sneakemail.com>
!
module gd_calc
type calc_signal_type
integer :: dummy
logical :: used
integer :: signal_number
end type
contains
subroutine activate_gd_calcs (used, outputs)
logical, intent(inout) :: used(:)
type(calc_signal_type), pointer :: outputs(:)
outputs%used = used(outputs%signal_number)
return
end subroutine activate_gd_calcs
end module gd_calc
use gd_calc
integer, parameter :: ndim = 4
integer :: i
logical :: used_(ndim)
type(calc_signal_type), pointer :: outputs_(:)
allocate (outputs_(ndim))
forall (i = 1:ndim) outputs_(i)%signal_number = ndim + 1 - i
used_ = (/.true., .false., .true., .true./)
call activate_gd_calcs (used_, outputs_)
if (any (outputs_(ndim:1:-1)%used .neqv. used_)) call abort ()
end
! { dg-final { cleanup-modules "gd_calc" } }