This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[patch, Fortran] Fix PR 66041


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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]