[patch, Fortran] Fix PR 66041

[patch, Fortran] Fix PR 66041

[Thomas Koenig]

[-- 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" } }

Re: [patch, Fortran] Fix PR 66041

[Mikael Morin]

[-- 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" } }

Re: [patch, Fortran] Fix PR 66041

[Thomas Koenig]

[-- 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" } }

Re: [patch, Fortran] Fix PR 66041

[Mikael Morin]

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

Re: [patch, Fortran] Fix PR 66041

[Thomas Koenig]

[-- 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" } }