re PR fortran/66041 (Matmul ICE)
authorThomas Koenig <tkoenig@gcc.gnu.org>
Sun, 10 May 2015 18:08:33 +0000 (18:08 +0000)
committerThomas Koenig <tkoenig@gcc.gnu.org>
Sun, 10 May 2015 18:08:33 +0000 (18:08 +0000)
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.

From-SVN: r222982

gcc/fortran/ChangeLog
gcc/fortran/frontend-passes.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/inline_matmul_7.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/inline_matmul_8.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/inline_matmul_9.f90 [new file with mode: 0644]

index b91f503..4b1c84f 100644 (file)
@@ -1,9 +1,18 @@
+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  Mikael Morin  <mikael@gcc.gnu.org>
 
        * simplify.c (simplify_bound_dim): Don't check for emptyness
        in the case of cobound simplification.  Factor lower/upper
        bound differenciation before the actual simplification.
-       (simplify_bound): Remove assumed shape specific simplification.  
+       (simplify_bound): Remove assumed shape specific simplification.
        Don't give up early for the lbound of an assumed shape.
 
 2015-05-09  Mikael Morin  <mikael@gcc.gnu.org>
index 62d1063..30085e8 100644 (file)
@@ -2607,18 +2607,55 @@ scalarized_expr (gfc_expr *e_in, gfc_expr **index, int count_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, int count_index)
          i_index ++;
        }
     }
+
   return e;
 }
 
@@ -2929,15 +2967,15 @@ inline_matmul_assign (gfc_code **c, int *walk_subtrees,
 
       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_subtrees,
       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_subtrees,
       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;
 
index 63ee9cc..9dda294 100644 (file)
@@ -1,3 +1,10 @@
+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.
+
 2015-05-10  Mikael Morin  <mikael@gcc.gnu.org>
 
        * gfortran.dg/bound_simplification_5.f90: New.
diff --git a/gcc/testsuite/gfortran.dg/inline_matmul_7.f90 b/gcc/testsuite/gfortran.dg/inline_matmul_7.f90
new file mode 100644 (file)
index 0000000..24f610a
--- /dev/null
@@ -0,0 +1,35 @@
+! { 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" } }
diff --git a/gcc/testsuite/gfortran.dg/inline_matmul_8.f90 b/gcc/testsuite/gfortran.dg/inline_matmul_8.f90
new file mode 100644 (file)
index 0000000..f7d2846
--- /dev/null
@@ -0,0 +1,18 @@
+! { 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" } }
diff --git a/gcc/testsuite/gfortran.dg/inline_matmul_9.f90 b/gcc/testsuite/gfortran.dg/inline_matmul_9.f90
new file mode 100644 (file)
index 0000000..ae80b18
--- /dev/null
@@ -0,0 +1,25 @@
+! { 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" } }