* [patch, Fortran] Fix PR 66041
@ 2015-05-08 22:11 Thomas Koenig
2015-05-09 11:59 ` Mikael Morin
0 siblings, 1 reply; 5+ messages in thread
From: Thomas Koenig @ 2015-05-08 22:11 UTC (permalink / raw)
To: fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 585 bytes --]
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 <tkoenig@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 <tkoenig@gcc.gnu.org>
PR fortran/66041
* gfortran.dg/inline_matmul_7.f90: New test.
* gfortran.dg/inline_matmul_8.f90: New test.
[-- Attachment #2: p2.diff --]
[-- Type: text/x-patch, Size: 1654 bytes --]
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;
}
[-- Attachment #3: inline_matmul_8.f90 --]
[-- Type: text/x-fortran, Size: 544 bytes --]
! { 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" } }
[-- Attachment #4: inline_matmul_7.f90 --]
[-- Type: text/x-fortran, Size: 997 bytes --]
! { 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" } }
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [patch, Fortran] Fix PR 66041
2015-05-08 22:11 [patch, Fortran] Fix PR 66041 Thomas Koenig
@ 2015-05-09 11:59 ` Mikael Morin
2015-05-09 22:31 ` Thomas Koenig
0 siblings, 1 reply; 5+ messages in thread
From: Mikael Morin @ 2015-05-09 11:59 UTC (permalink / raw)
To: Thomas Koenig, fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 2487 bytes --]
Hello,
Le 09/05/2015 00:11, Thomas Koenig a écrit :
> 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;
> + }
> +
You also need to remove/free the trailing subreferences.
> + /* 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;
ar->dimen is not what you think it is.
It is 3 for array(1, 1, :), while the rank is 1.
gfc_resolve_expr should set the rank for you, so just remove this line.
> +
> + gfc_resolve_expr (lbound_e);
> + lbound = get_array_inq_function (GFC_ISYM_LBOUND,
> + lbound_e, i + 1);
free lbound_e?
> }
> - 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);
You can't reuse e_in if it has subreferences.
One suggestion: you may want to move all the above to a function
extracting the full array.
> }
>
> 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);
> +
This side effect is asking for trouble.
Instead of this, remove the copies made in the callers.
This is independant from the rest, so it can be made later as a follow-up.
> return e;
> }
>
>
I attach a variant of your inline_matmul_8.f90 that is not working yet
because of subreferences.
Mikael
[-- Attachment #2: inline_matmul_8.f90.diff --]
[-- Type: text/x-patch, Size: 840 bytes --]
--- inline_matmul_8.f90.old 2015-05-09 13:31:28.420790646 +0200
+++ inline_matmul_8.f90 2015-05-09 13:42:50.741799982 +0200
@@ -3,15 +3,22 @@
! PR 66041 - this used to ICE with an incomplete fix for the PR.
program main
implicit none
- real, dimension(1,-2:0) :: a1
+ type :: t
+ real :: c
+ end type t
+ type(t), dimension(1,-2:0) :: a1
real, dimension(3,2) :: b1
real, dimension(2) :: c1
+ real, dimension(1,2) :: c2
- data a1 /17., -23., 29./
+ data a1%c /17., -23., 29./
data b1 / 2., -3., 5., -7., 11., -13./
- c1 = matmul(a1(1,:), b1)
+ c1 = matmul(a1(1,:)%c, b1)
if (any (c1-[248., -749.] /= 0.)) call abort
+
+ c2 = matmul(a1%c, b1)
+ if (any (c2-reshape([248., -749.],shape(c2)) /= 0.)) call abort
end program main
! { dg-final { scan-tree-dump-times "_gfortran_matmul" 0 "original" } }
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [patch, Fortran] Fix PR 66041
2015-05-09 11:59 ` Mikael Morin
@ 2015-05-09 22:31 ` Thomas Koenig
2015-05-10 13:31 ` Mikael Morin
0 siblings, 1 reply; 5+ messages in thread
From: Thomas Koenig @ 2015-05-09 22:31 UTC (permalink / raw)
To: Mikael Morin, fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 2487 bytes --]
Am 09.05.2015 um 13:59 schrieb Mikael Morin:
> You also need to remove/free the trailing subreferences.
That's right, I did that. Although I will probably never understand
why lbound(a) should be different from lbound(a%r)...
>> + /* 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;
> ar->dimen is not what you think it is.
> It is 3 for array(1, 1, :), while the rank is 1.
> gfc_resolve_expr should set the rank for you, so just remove this line.
It doesn't (for whatever reason), so I kept on setting it.
>> +
>> + gfc_resolve_expr (lbound_e);
>> + lbound = get_array_inq_function (GFC_ISYM_LBOUND,
>> + lbound_e, i + 1);
> free lbound_e?
It will be part of the lbound expression, or be simplified away.
>
>> }
>> - 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);
> You can't reuse e_in if it has subreferences.
Changed.
>> }
>>
>> 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);
>> +
> This side effect is asking for trouble.
> Instead of this, remove the copies made in the callers.
> This is independant from the rest, so it can be made later as a follow-up.
Done (all in once).
I have attached the new patch (in which I also restructured the test),
plus the test cases.
OK for trunk?
Thomas
2015-05-08 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/66041
* frontend-passes.c (scalarized_expr): Copy first argument so it
is not necessary to call gfc_copy_expr() on its argument. Set
correct dimension and shape for the expression to be passed to
lbound. Remove trailing references after array refrence.
(inline_matmul_assign): Remove gfc_copy_expr() from calls
to scalarized_expr().
2015-05-08 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/66041
* gfortran.dg/inline_matmul_7.f90: New test.
* gfortran.dg/inline_matmul_8.f90: New test.
* gfortran.dg/inline_matmul_9.f90: New test.
[-- Attachment #2: p5.diff --]
[-- Type: text/x-patch, Size: 4119 bytes --]
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 222864)
+++ frontend-passes.c (Arbeitskopie)
@@ -2532,16 +2532,17 @@ get_size_m1 (gfc_expr *e, int dimen)
references have been frozen. */
static gfc_expr*
-scalarized_expr (gfc_expr *e_in, gfc_expr **index, int count_index)
+scalarized_expr (gfc_expr *ei, gfc_expr **index, int count_index)
{
gfc_array_ref *ar;
int i;
int rank;
- gfc_expr *e;
+ gfc_expr *e, *e_in;
int i_index;
bool was_fullref;
- e = gfc_copy_expr(e_in);
+ e = gfc_copy_expr(ei);
+ e_in = gfc_copy_expr (ei);
rank = e->rank;
@@ -2607,18 +2608,54 @@ static gfc_expr*
}
else
{
+ gfc_expr *lbound_e;
+ gfc_ref *ref;
+
+ lbound_e = gfc_copy_expr (e_in);
+
+ for (ref = lbound_e->ref; ref; ref = ref->next)
+ if (ref->type == REF_ARRAY
+ && (ref->u.ar.type == AR_FULL
+ || ref->u.ar.type == AR_SECTION))
+ break;
+
+ if (ref->next)
+ {
+ gfc_free_ref_list (ref->next);
+ ref->next = NULL;
+ }
+
if (!was_fullref)
{
/* Look at full individual sections, like a(:). The first index
is the lbound of a full ref. */
-
+ int j;
gfc_array_ref *ar;
- ar = gfc_find_array_ref (e_in);
+ ar = &ref->u.ar;
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 there 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, e_in,
- i_index + 1);
+ lbound = get_array_inq_function (GFC_ISYM_LBOUND, lbound_e,
+ i + 1);
}
ar->dimen_type[i] = DIMEN_ELEMENT;
@@ -2639,6 +2676,8 @@ static gfc_expr*
i_index ++;
}
}
+ gfc_free_expr (e_in);
+
return e;
}
@@ -2929,15 +2968,15 @@ inline_matmul_assign (gfc_code **c, int *walk_subt
list[0] = var_3;
list[1] = var_1;
- cscalar = scalarized_expr (gfc_copy_expr (co->expr1), list, 2);
+ cscalar = scalarized_expr (co->expr1, list, 2);
list[0] = var_3;
list[1] = var_2;
- ascalar = scalarized_expr (gfc_copy_expr (matrix_a), list, 2);
+ ascalar = scalarized_expr (matrix_a, list, 2);
list[0] = var_2;
list[1] = var_1;
- bscalar = scalarized_expr (gfc_copy_expr (matrix_b), list, 2);
+ bscalar = scalarized_expr (matrix_b, list, 2);
break;
@@ -2955,14 +2994,14 @@ inline_matmul_assign (gfc_code **c, int *walk_subt
var_2 = do_2->ext.iterator->var;
list[0] = var_2;
- cscalar = scalarized_expr (gfc_copy_expr (co->expr1), list, 1);
+ cscalar = scalarized_expr (co->expr1, list, 1);
list[0] = var_2;
list[1] = var_1;
- ascalar = scalarized_expr (gfc_copy_expr (matrix_a), list, 2);
+ ascalar = scalarized_expr (matrix_a, list, 2);
list[0] = var_1;
- bscalar = scalarized_expr (gfc_copy_expr (matrix_b), list, 1);
+ bscalar = scalarized_expr (matrix_b, list, 1);
break;
@@ -2980,14 +3019,14 @@ inline_matmul_assign (gfc_code **c, int *walk_subt
var_2 = do_2->ext.iterator->var;
list[0] = var_1;
- cscalar = scalarized_expr (gfc_copy_expr (co->expr1), list, 1);
+ cscalar = scalarized_expr (co->expr1, list, 1);
list[0] = var_2;
- ascalar = scalarized_expr (gfc_copy_expr (matrix_a), list, 1);
+ ascalar = scalarized_expr (matrix_a, list, 1);
list[0] = var_2;
list[1] = var_1;
- bscalar = scalarized_expr (gfc_copy_expr (matrix_b), list, 2);
+ bscalar = scalarized_expr (matrix_b, list, 2);
break;
[-- Attachment #3: inline_matmul_7.f90 --]
[-- Type: text/x-fortran, Size: 997 bytes --]
! { 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" } }
[-- Attachment #4: inline_matmul_8.f90 --]
[-- Type: text/x-fortran, Size: 544 bytes --]
! { 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" } }
[-- Attachment #5: inline_matmul_9.f90 --]
[-- Type: text/x-fortran, Size: 710 bytes --]
! { 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
type :: t
real :: c
end type t
type(t), dimension(1,-2:0) :: a1
real, dimension(3,2) :: b1
real, dimension(2) :: c1
real, dimension(1,2) :: c2
data a1%c /17., -23., 29./
data b1 / 2., -3., 5., -7., 11., -13./
c1 = matmul(a1(1,:)%c, b1)
if (any (c1-[248., -749.] /= 0.)) call abort
c2 = matmul(a1%c, b1)
if (any (c2-reshape([248., -749.],shape(c2)) /= 0.)) call abort
end program main
! { dg-final { scan-tree-dump-times "_gfortran_matmul" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [patch, Fortran] Fix PR 66041
2015-05-09 22:31 ` Thomas Koenig
@ 2015-05-10 13:31 ` Mikael Morin
2015-05-10 18:40 ` Thomas Koenig
0 siblings, 1 reply; 5+ messages in thread
From: Mikael Morin @ 2015-05-10 13:31 UTC (permalink / raw)
To: Thomas Koenig, fortran, gcc-patches
Hello,
Le 10/05/2015 00:31, Thomas Koenig a écrit :
> Am 09.05.2015 um 13:59 schrieb Mikael Morin:
>>> + /* 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;
>> ar->dimen is not what you think it is.
>> It is 3 for array(1, 1, :), while the rank is 1.
>
>> gfc_resolve_expr should set the rank for you, so just remove this line.
>
> It doesn't (for whatever reason), so I kept on setting it.
It seems to work here.
In fact ar->dimen is the correct setting here, as the array is full.
But it will be overwritten (by the same value) in gfc_resolve_expr.
Anyway, it doesn't matter.
>
>>> +
>>> + gfc_resolve_expr (lbound_e);
>>> + lbound = get_array_inq_function (GFC_ISYM_LBOUND,
>>> + lbound_e, i + 1);
>> free lbound_e?
>
> It will be part of the lbound expression, or be simplified away.
get_array_inq_function makes a copy, so a _copy_ of lbound_e is in lbound.
>>> @@ -2639,6 +2665,8 @@ scalarized_expr (gfc_expr *e_in, gfc_expr **index,
>>> i_index ++;
>>> }
>>> }
>>> + gfc_free_expr (e_in);
>>> +
>> This side effect is asking for trouble.
>> Instead of this, remove the copies made in the callers.
>> This is independant from the rest, so it can be made later as a follow-up.
>
> Done (all in once).
>
e_in is a copy of ei and is used unmodified as input for the copy to
lbound_e, so it can be removed completely.
OK with that change. Thanks.
Mikael
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [patch, Fortran] Fix PR 66041
2015-05-10 13:31 ` Mikael Morin
@ 2015-05-10 18:40 ` Thomas Koenig
0 siblings, 0 replies; 5+ messages in thread
From: Thomas Koenig @ 2015-05-10 18:40 UTC (permalink / raw)
To: Mikael Morin, fortran, gcc-patches
[-- Attachment #1: Type: text/plain, Size: 677 bytes --]
Hi Mikael,
thanks for the review.
Here is what I committed.
Regards
Thomas
2015-05-10 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/66041
* frontend-passes.c (scalarized_expr): Set correct dimension and
shape for the expression to be passed to lbound. Remove trailing
references after array refrence.
(inline_matmul_assign): Remove gfc_copy_expr from calls
to scalarized_expr().
2015-05-10 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/66041
* gfortran.dg/inline_matmul_7.f90: New test.
* gfortran.dg/inline_matmul_8.f90: New test.
* gfortran.dg/inline_matmul_9.f90: New test.
[-- Attachment #2: p6.diff --]
[-- Type: text/x-patch, Size: 3708 bytes --]
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 222864)
+++ frontend-passes.c (Arbeitskopie)
@@ -2607,18 +2607,55 @@ scalarized_expr (gfc_expr *e_in, gfc_expr **index,
}
else
{
+ gfc_expr *lbound_e;
+ gfc_ref *ref;
+
+ lbound_e = gfc_copy_expr (e_in);
+
+ for (ref = lbound_e->ref; ref; ref = ref->next)
+ if (ref->type == REF_ARRAY
+ && (ref->u.ar.type == AR_FULL
+ || ref->u.ar.type == AR_SECTION))
+ break;
+
+ if (ref->next)
+ {
+ gfc_free_ref_list (ref->next);
+ ref->next = NULL;
+ }
+
if (!was_fullref)
{
/* Look at full individual sections, like a(:). The first index
is the lbound of a full ref. */
-
+ int j;
gfc_array_ref *ar;
- ar = gfc_find_array_ref (e_in);
+ ar = &ref->u.ar;
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 there 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, e_in,
- i_index + 1);
+ lbound = get_array_inq_function (GFC_ISYM_LBOUND, lbound_e,
+ i + 1);
+ gfc_free_expr (lbound_e);
}
ar->dimen_type[i] = DIMEN_ELEMENT;
@@ -2639,6 +2676,7 @@ scalarized_expr (gfc_expr *e_in, gfc_expr **index,
i_index ++;
}
}
+
return e;
}
@@ -2929,15 +2967,15 @@ inline_matmul_assign (gfc_code **c, int *walk_subt
list[0] = var_3;
list[1] = var_1;
- cscalar = scalarized_expr (gfc_copy_expr (co->expr1), list, 2);
+ cscalar = scalarized_expr (co->expr1, list, 2);
list[0] = var_3;
list[1] = var_2;
- ascalar = scalarized_expr (gfc_copy_expr (matrix_a), list, 2);
+ ascalar = scalarized_expr (matrix_a, list, 2);
list[0] = var_2;
list[1] = var_1;
- bscalar = scalarized_expr (gfc_copy_expr (matrix_b), list, 2);
+ bscalar = scalarized_expr (matrix_b, list, 2);
break;
@@ -2955,14 +2993,14 @@ inline_matmul_assign (gfc_code **c, int *walk_subt
var_2 = do_2->ext.iterator->var;
list[0] = var_2;
- cscalar = scalarized_expr (gfc_copy_expr (co->expr1), list, 1);
+ cscalar = scalarized_expr (co->expr1, list, 1);
list[0] = var_2;
list[1] = var_1;
- ascalar = scalarized_expr (gfc_copy_expr (matrix_a), list, 2);
+ ascalar = scalarized_expr (matrix_a, list, 2);
list[0] = var_1;
- bscalar = scalarized_expr (gfc_copy_expr (matrix_b), list, 1);
+ bscalar = scalarized_expr (matrix_b, list, 1);
break;
@@ -2980,14 +3018,14 @@ inline_matmul_assign (gfc_code **c, int *walk_subt
var_2 = do_2->ext.iterator->var;
list[0] = var_1;
- cscalar = scalarized_expr (gfc_copy_expr (co->expr1), list, 1);
+ cscalar = scalarized_expr (co->expr1, list, 1);
list[0] = var_2;
- ascalar = scalarized_expr (gfc_copy_expr (matrix_a), list, 1);
+ ascalar = scalarized_expr (matrix_a, list, 1);
list[0] = var_2;
list[1] = var_1;
- bscalar = scalarized_expr (gfc_copy_expr (matrix_b), list, 2);
+ bscalar = scalarized_expr (matrix_b, list, 2);
break;
[-- Attachment #3: inline_matmul_7.f90 --]
[-- Type: text/x-fortran, Size: 997 bytes --]
! { 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" } }
[-- Attachment #4: inline_matmul_8.f90 --]
[-- Type: text/x-fortran, Size: 544 bytes --]
! { 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" } }
[-- Attachment #5: inline_matmul_9.f90 --]
[-- Type: text/x-fortran, Size: 710 bytes --]
! { 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
type :: t
real :: c
end type t
type(t), dimension(1,-2:0) :: a1
real, dimension(3,2) :: b1
real, dimension(2) :: c1
real, dimension(1,2) :: c2
data a1%c /17., -23., 29./
data b1 / 2., -3., 5., -7., 11., -13./
c1 = matmul(a1(1,:)%c, b1)
if (any (c1-[248., -749.] /= 0.)) call abort
c2 = matmul(a1%c, b1)
if (any (c2-reshape([248., -749.],shape(c2)) /= 0.)) call abort
end program main
! { dg-final { scan-tree-dump-times "_gfortran_matmul" 0 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2015-05-10 18:40 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-05-08 22:11 [patch, Fortran] Fix PR 66041 Thomas Koenig
2015-05-09 11:59 ` Mikael Morin
2015-05-09 22:31 ` Thomas Koenig
2015-05-10 13:31 ` Mikael Morin
2015-05-10 18:40 ` Thomas Koenig
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).