ICE in gfc_get_dataptr_offset, at fortran/trans-array.c:6951

 gcc/testsuite/
	Backport from mainline.
	2020-03-08  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/93581
	* resolve.c (gfc_resolve_ref): Modify array refs to be elements
	if the ref chain ends in INQUIRY_LEN.
	* trans-array.c (gfc_get_dataptr_offset): Provide the offsets
	for INQUIRY_RE and INQUIRY_IM.

gcc/testsuite/
	Backport from mainline.
	2020-03-08  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/93581
	* gfortran.dg/inquiry_type_ref_6.f90 : New test.

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c2032eccac93c4c8cf6b3c29df0b3c606721bc35..21f8b1afa79b6251d747c5c0b2211411347aae40 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2020-05-04  Tobias Burnus  <tobias@codesourcery.com>
+
+       Backport from mainline.
+       2020-03-08  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/93581
+       * resolve.c (gfc_resolve_ref): Modify array refs to be elements
+       if the ref chain ends in INQUIRY_LEN.
+       * trans-array.c (gfc_get_dataptr_offset): Provide the offsets
+       for INQUIRY_RE and INQUIRY_IM.
+
 2020-04-27  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/93956

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index a3df534180c6c8638d593a50b863ea3f4d69277e..c041d8df96d476d3f200c7c84df439bab5ddf145 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5094,8 +5094,8 @@ gfc_resolve_substring_charlen (gfc_expr *e)
 static bool
 resolve_ref (gfc_expr *expr)
 {
-  int current_part_dimension, n_components, seen_part_dimension;
-  gfc_ref *ref, **prev;
+  int current_part_dimension, n_components, seen_part_dimension, dim;
+  gfc_ref *ref, **prev, *array_ref;
   bool equal_length;
 
   for (ref = expr->ref; ref; ref = ref->next)
@@ -5141,12 +5141,14 @@ resolve_ref (gfc_expr *expr)
   current_part_dimension = 0;
   seen_part_dimension = 0;
   n_components = 0;
+  array_ref = NULL;
 
   for (ref = expr->ref; ref; ref = ref->next)
     {
       switch (ref->type)
        {
        case REF_ARRAY:
+         array_ref = ref;
          switch (ref->u.ar.type)
            {
            case AR_FULL:
@@ -5162,6 +5164,7 @@ resolve_ref (gfc_expr *expr)
              break;
 
            case AR_ELEMENT:
+             array_ref = NULL;
              current_part_dimension = 0;
              break;
 
@@ -5201,7 +5204,33 @@ resolve_ref (gfc_expr *expr)
          break;
 
        case REF_SUBSTRING:
+         break;
+
        case REF_INQUIRY:
+         /* Implement requirement in note 9.7 of F2018 that the result of the
+            LEN inquiry be a scalar.  */
+         if (ref->u.i == INQUIRY_LEN && array_ref)
+           {
+             array_ref->u.ar.type = AR_ELEMENT;
+             expr->rank = 0;
+             /* INQUIRY_LEN is not evaluated from the the rest of the expr
+                but directly from the string length. This means that setting
+                the array indices to one does not matter but might trigger
+                a runtime bounds error. Suppress the check.  */
+             expr->no_bounds_check = 1;
+             for (dim = 0; dim < array_ref->u.ar.dimen; dim++)
+               {
+                 array_ref->u.ar.dimen_type[dim] = DIMEN_ELEMENT;
+                 if (array_ref->u.ar.start[dim])
+                   gfc_free_expr (array_ref->u.ar.start[dim]);
+                 array_ref->u.ar.start[dim]
+                       = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+                 if (array_ref->u.ar.end[dim])
+                   gfc_free_expr (array_ref->u.ar.end[dim]);
+                 if (array_ref->u.ar.stride[dim])
+                   gfc_free_expr (array_ref->u.ar.stride[dim]);
+               }
+           }
          break;
        }
 

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 2e5eb4f468f522f878267daf0c6a81bc977f2a18..572455e0d59ce566d401542b61b05793eb24af40 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6945,6 +6945,24 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset,
              tmp = gfc_build_array_ref (tmp, index, NULL);
              break;
 
+           case REF_INQUIRY:
+             switch (ref->u.i)
+               {
+               case INQUIRY_RE:
+                 tmp = fold_build1_loc (input_location, REALPART_EXPR,
+                                        TREE_TYPE (TREE_TYPE (tmp)), tmp);
+                 break;
+
+               case INQUIRY_IM:
+                 tmp = fold_build1_loc (input_location, IMAGPART_EXPR,
+                                        TREE_TYPE (TREE_TYPE (tmp)), tmp);
+                 break;
+
+               default:
+                 break;
+               }
+             break;
+
            default:
              gcc_unreachable ();
              break;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c18a18687c237a23ad372c7b5dc536fec79ddb36..4a335f474debb73955d52f331b6b5047f41b0507 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2020-05-04  Tobias Burnus  <tobias@codesourcery.com>
+
+       Backport from mainline.
+       2020-03-08  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/93581
+       * gfortran.dg/inquiry_type_ref_6.f90 : New test.
+
 2020-05-04  Andreas Krebbel  <krebbel@linux.ibm.com>
 
        Backport from mainline

diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_6.f90 b/gcc/testsuite/gfortran.dg/inquiry_type_ref_6.f90
new file mode 100644 (file)
index 0000000..ffe09b0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquiry_type_ref_6.f90
@@ -0,0 +1,24 @@
+! { dg-do run }
+! { dg-options "-fcheck=all" }
+!
+! Test the fix for PR93581 and the implementation of note 9.7 of F2018.
+! The latter requires that the result of the LEN inquiry be a scalar
+! even for array expressions.
+!
+! Contributed by Gerhard Steinmetz  <gscfq@t-online.de>
+!
+program p
+   complex, target :: z(2) = [(1.0, 2.0),(3.0, 4.0)]
+   character(:), allocatable, target :: c(:)
+   real, pointer :: r(:)
+   character(:), pointer :: s(:)
+
+   r => z%re
+   if (any (r .ne. real (z))) stop 1
+   r => z%im
+   if (any (r .ne. imag (z))) stop 2
+
+   allocate (c, source = ['abc','def'])
+   s(-2:-1) => c(1:2)
+   if (s%len .ne. len (c)) stop 3
+end