re PR fortran/84270 (optimization bug with assumed size array argument)

2018-02-17  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/84270
	* frontend-passes (scalarized_expr):  If the expression
	is an assumed size array, leave in the last reference
	and pass AR_SECTION instead of AR_FULL to gfc_resolve
	in order to avoid an error.

2018-02-17  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/84270
	* gfortran.dg/inline_matmul_22.f90: New test.

From-SVN: r257783

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index af345eafd5cb59b339504aa6a6a1e0eba3e14040..ce98b760ec8457d1a08599789b8a79674f524e8e 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2018-02-17  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/84270
+       * frontend-passes (scalarized_expr):  If the expression
+       is an assumed size array, leave in the last reference
+       and pass AR_SECTION instead of AR_FULL to gfc_resolve
+       in order to avoid an error.
+
 2018-02-17  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/84115

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index 11a5b9b779c7b58208edf196af24728f32113808..d07d142faa443c5df2167c91a82d491df0751c1d 100644 (file)
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -3567,10 +3567,26 @@ scalarized_expr (gfc_expr *e_in, gfc_expr **index, int count_index)
                         is the lbound of a full ref.  */
                      int j;
                      gfc_array_ref *ar;
+                     int to;
 
                      ar = &ref->u.ar;
-                     ar->type = AR_FULL;
-                     for (j = 0; j < ar->dimen; j++)
+
+                     /* For assumed size, we need to keep around the final
+                        reference in order not to get an error on resolution
+                        below, and we cannot use AR_FULL.  */
+                        
+                     if (ar->as->type == AS_ASSUMED_SIZE)
+                       {
+                         ar->type = AR_SECTION;
+                         to = ar->dimen - 1;
+                       }
+                     else
+                       {
+                         to = ar->dimen;
+                         ar->type = AR_FULL;
+                       }
+
+                     for (j = 0; j < to; j++)
                        {
                          gfc_free_expr (ar->start[j]);
                          ar->start[j] = NULL;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 456a3fb303d77982a3d1e812f417419cdca3ef55..76d8f4982957285e1eaaf20e89ca651483634c70 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-02-17  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/84270
+       * gfortran.dg/inline_matmul_22.f90: New test.
+
 2018-02-17  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/84381

diff --git a/gcc/testsuite/gfortran.dg/inline_matmul_22.f90 b/gcc/testsuite/gfortran.dg/inline_matmul_22.f90
new file mode 100644 (file)
index 0000000..702e32e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inline_matmul_22.f90
@@ -0,0 +1,44 @@
+! { dg-do compile }
+! { dg-additional-options "-ffrontend-optimize" }
+! PR 84270 - this used to be rejected.
+! Test case by Michael Weinert
+
+module fp_precision
+
+   integer, parameter   :: fp = selected_real_kind(13)
+
+end module fp_precision
+
+      subroutine lhcal(nrot,orth,ngpts,vgauss,vr_0)
+
+      use fp_precision  ! floating point precision
+
+      implicit none
+
+!--->    rotation matrices and rotations (input)
+      integer,          intent(in)  :: nrot
+!     real(kind=fp),    intent(in)  :: orth(3,3,nrot)  ! fine at all -O
+      real(kind=fp),    intent(in)  :: orth(3,3,*)
+
+!--->    gaussian integration points
+      integer,          intent(in)  :: ngpts
+      real(kind=fp),    intent(in)  :: vgauss(3,*)
+
+!--->    output results
+      real(kind=fp),    intent(out) :: vr_0(3)
+
+      real(kind=fp)     :: v(3),vr(3)
+      integer           :: n,nn
+
+      vr_0 = 0
+      do nn=1,ngpts
+         v(:) = vgauss(:,nn)
+!--->    apply rotations
+         do n=2,nrot
+            vr = matmul( orth(:,:,n), v )
+            vr_0 = vr_0 + vr
+         enddo
+      enddo
+
+      return
+      end subroutine lhcal