Patch and ChangeLogs for PR93581

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 90e1cab..b3ff063 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+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-03-05 Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/93792

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8f5267f..b5813a7 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5199,8 +5199,8 @@ gfc_resolve_substring_charlen (gfc_expr *e)
 bool
 gfc_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)
@@ -5246,12 +5246,14 @@ gfc_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:
@@ -5267,6 +5269,7 @@ gfc_resolve_ref (gfc_expr *expr)
              break;
 
            case AR_ELEMENT:
+             array_ref = NULL;
              current_part_dimension = 0;
              break;
 
@@ -5306,7 +5309,33 @@ gfc_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 65ba84c..a4b1cba 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -6947,6 +6947,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 a1a371b..722a473 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2020-03-08  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/93581
+       * gfortran.dg/inquiry_type_ref_6.f90 : New test.
+
 2020-03-08  Patrick Palka  <ppalka@redhat.com>
 
        PR c++/93729
@@ -20,7 +25,7 @@
 
 2020-03-06  Wilco Dijkstra  <wdijkstr@arm.com>
 
-       * gcc.target/aarch64/fmla_intrinsic_1.c: Check for correct lane syntax. 
+       * gcc.target/aarch64/fmla_intrinsic_1.c: Check for correct lane syntax.
        * gcc.target/aarch64/fmls_intrinsic_1.c: Likewise.
        * gcc.target/aarch64/mla_intrinsic_1.c: Likewise.
        * gcc.target/aarch64/mls_intrinsic_1.c: Likewise.

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