[gcc(refs/users/marxin/heads/opt-parse-enum-sanity)] Commit for PR92785

[Martin Liska]

https://gcc.gnu.org/g:7485ace81de9ec9dd5c87edf67e359d31ce35a20

commit 7485ace81de9ec9dd5c87edf67e359d31ce35a20
Author: Paul Thomas <pault@pc30.home>
Date:   Fri Feb 28 18:30:57 2020 +0000

    Commit for PR92785

Diff:
---
 gcc/fortran/ChangeLog                              |  6 +++
 gcc/fortran/trans-expr.c                           | 11 +++++
 gcc/testsuite/ChangeLog                            |  7 ++-
 .../gfortran.dg/unlimited_polymorphic_31.f03       | 55 ++++++++++++++++++++++
 4 files changed, 78 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d9dd618cc87..b9293de9da9 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2020-02-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/92785
+	* trans-expr.c (gfc_conv_intrinsic_to_class): Renormalise non-
+	variable expressions to be unity lbound based.
+
 2020-02-25  Steven G. Kargl  <kargl@gcc.gnu.org>
 
 	* simplify.c (degrees_f): Remove unused code.
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 5825a4b8ce3..9d0921eeed3 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -843,6 +843,7 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
   tree ctree;
   tree var;
   tree tmp;
+  int dim;
 
   /* The intrinsic type needs to be converted to a temporary
      CLASS object.  */
@@ -892,6 +893,16 @@ gfc_conv_intrinsic_to_class (gfc_se *parmse, gfc_expr *e,
 	  parmse->ss = ss;
 	  parmse->use_offset = 1;
 	  gfc_conv_expr_descriptor (parmse, e);
+
+	  /* Array references with vector subscripts and non-variable expressions
+	     need be converted to a one-based descriptor.  */
+	  if (e->expr_type != EXPR_VARIABLE)
+	    {
+	      for (dim = 0; dim < e->rank; ++dim)
+		gfc_conv_shift_descriptor_lbound (&parmse->pre, parmse->expr,
+						  dim, gfc_index_one_node);
+	    }
+
 	  if (class_ts.u.derived->components->as->rank != e->rank)
 	    {
 	      tmp = fold_build1_loc (input_location, VIEW_CONVERT_EXPR,
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3727ae255fe..c14935705fb 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2020-02-28  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/92785
+	* gfortran.dg/unlimited_polymorphic_31.f03 : New test.
+
 2020-02-28  Jakub Jelinek  <jakub@redhat.com>
 
 	P1937R2 - Fixing inconsistencies between const{expr,eval} functions
@@ -987,7 +992,7 @@
 	PR c++/93559 - ICE with CONSTRUCTOR flags verification.
 	* g++.dg/cpp0x/initlist119.C: New test.
 	* g++.dg/cpp0x/initlist120.C: New test.
-	
+
 2020-02-05  Jakub Jelinek  <jakub@redhat.com>
 
 	PR c++/93557
diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_31.f03 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_31.f03
new file mode 100644
index 00000000000..dd47c34989e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_31.f03
@@ -0,0 +1,55 @@
+! { dg-do run }
+!
+! Test the fix for PR92785, where the array passed to 'write scalar' was not
+! normalised to LBOUND = 1.
+!
+! Contributed by  <urbanjost@comcast.net>
+!
+   program tst
+      use iso_fortran_env, only : compiler_version, compiler_options
+      implicit none
+      integer :: i
+      integer :: ibad=0
+      integer :: iarr(10) = [(i*10, i = 1,size (iarr))]
+      character(len=:), allocatable :: line
+      character(len=*), parameter :: expected = '10 20 30 40 50 60 70 80 90 100'
+      character(len=*), parameter :: expected_minus = '-10 -20 -30 -40 -50 -60 -70 -80 -90 -100'
+      print '(4a)', &
+         'This file was compiled by ', compiler_version(), &
+         ' using the options ',        compiler_options()
+      call write_row ('iarr                   ', iarr)                    ! pass in the array, OK
+      call write_row ('iarr+0                 ', iarr+0)                  ! pass in an expression, NOT OK
+      call write_row ('-iarr                  ', -iarr)                   ! pass in an expression, NOT OK
+      call write_row ('iarr(::1)              ', iarr(::1))               ! pass in the array, OK
+      call write_row ('[iarr(::1)]            ', [iarr(::1)])             ! pass in compound constructor, NOT OK
+      call write_row ('[(i*10,i=1,size(iarr))]', [(i*10,i=1,size(iarr))]) ! pass in constructor, OK
+      call write_row ('10*[(i,i=1,size(iarr))]', 10*[(i,i=1,size(iarr))]) ! pass in constructor, OK
+      if (ibad .gt. 0) stop 'FAILED'
+   contains
+      subroutine write_scalar (g1)
+         class(*) :: g1
+         character(len = 20) :: word
+         select type(g1)
+          type is (integer)
+            write (word, '(i0)') g1
+            line = line // trim( word) // ' '
+         end select
+      end subroutine write_scalar
+      subroutine write_row (string,array)
+         character(len = *) :: string
+         class(*) :: array(:)
+         integer  :: i
+         line = ''
+         do i = 1, size (array)
+            call write_scalar (array(i))
+         enddo
+         if (expected .eq. line) then
+            write (*, *) string, ':GOOD'
+         else if (expected_minus .eq. line) then
+            write (*, *) string, ':GOOD'
+         else
+            write (*, *) string, ':BAD. EXPECTED [', expected, '] got [', trim (line),']'
+            ibad = ibad + 1
+         endif
+      end subroutine write_row
+   end program tst