Hello world,
this patch fixes the regression in PR 66041, plus one more case
that came up when I looked at this.
OK for trunk?
Regards, Thomas
2015-05-08 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/66041
* frontend-passes.c (scalarized_expr): Clear as->start, as->end
and as->stride. Set correct dimension and shape for the
expression to be passed to lbound. Free e_in.
2015-05-08 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/66041
* gfortran.dg/inline_matmul_7.f90: New test.
* gfortran.dg/inline_matmul_8.f90: New test.
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 222864)
+++ frontend-passes.c (Arbeitskopie)
@@ -2611,14 +2611,40 @@ scalarized_expr (gfc_expr *e_in, gfc_expr **index,
{
/* Look at full individual sections, like a(:). The first index
is the lbound of a full ref. */
-
+ int j;
gfc_array_ref *ar;
+ gfc_expr *lbound_e;
- ar = gfc_find_array_ref (e_in);
+ lbound_e = gfc_copy_expr (e_in);
+ ar = gfc_find_array_ref (lbound_e);
+
ar->type = AR_FULL;
+ for (j = 0; j < ar->dimen; j++)
+ {
+ gfc_free_expr (ar->start[j]);
+ ar->start[j] = NULL;
+ gfc_free_expr (ar->end[j]);
+ ar->end[j] = NULL;
+ gfc_free_expr (ar->stride[j]);
+ ar->stride[j] = NULL;
+ }
+
+ /* We have to get rid of the shape, if thre is one. Do
+ so by freeing it and calling gfc_resolve to rebuild it,
+ if necessary. */
+
+ if (lbound_e->shape)
+ gfc_free_shape (&(lbound_e->shape), lbound_e->rank);
+
+ lbound_e->rank = ar->dimen;
+
+ gfc_resolve_expr (lbound_e);
+ lbound = get_array_inq_function (GFC_ISYM_LBOUND,
+ lbound_e, i + 1);
}
- lbound = get_array_inq_function (GFC_ISYM_LBOUND, e_in,
- i_index + 1);
+ else
+ lbound = get_array_inq_function (GFC_ISYM_LBOUND, e_in,
+ i_index + 1);
}
ar->dimen_type[i] = DIMEN_ELEMENT;
@@ -2639,6 +2665,8 @@ scalarized_expr (gfc_expr *e_in, gfc_expr **index,
i_index ++;
}
}
+ gfc_free_expr (e_in);
+
return e;
}
! { dg-do run }
! { dg-options "-ffrontend-optimize -fdump-tree-original" }
! PR 66041 - this used to ICE with an incomplete fix for the PR.
program main
implicit none
real, dimension(1,-2:0) :: a1
real, dimension(3,2) :: b1
real, dimension(2) :: c1
data a1 /17., -23., 29./
data b1 / 2., -3., 5., -7., 11., -13./
c1 = matmul(a1(1,:), b1)
if (any (c1-[248., -749.] /= 0.)) call abort
end program main
! { dg-final { scan-tree-dump-times "_gfortran_matmul" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
! { dg-do run }
! { dg-options "-ffrontend-optimize -fdump-tree-original" }
program main
implicit none
real(kind=8), ALLOCATABLE :: a(:,:), b(:,:), v1(:), v2(:)
real(kind=8), dimension(3,3) :: v1res, v2res
integer :: n, i
data v1res/ 442.d0, -492.d0, 586.d0, &
-4834.d0, 5694.d0, -7066.d0, &
13042.d0, -15450.d0, 19306.d0 /
data v2res/ 5522.d0, -6310.d0, 7754.d0, &
-7794.d0, 8982.d0, -11034.d0, &
10490.d0, -12160.d0, 14954.d0 /
n = 3
ALLOCATE(a(N,N),b(N,N),v1(N), v2(N))
a = reshape([((-1)**i*(-i-5)*(i+3)+5,i=1,n**2)], shape(a))
b = reshape([((-1)**i*(-i-1)*(i-2),i=1,n**2)], shape(a))
DO i=1,N
v1 = MATMUL(a,b(:,i))
if (any(abs(v1-v1res(:,i)) > 1e-10)) call abort
v2 = MATMUL(a,b(i,:))
if (any(abs(v2-v2res(:,i)) > 1e-10)) call abort
ENDDO
END program main
! { dg-final { scan-tree-dump-times "_gfortran_matmul" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
