[Patch, fortran] PR84119 - Type parameter inquiry for PDT returns array instead of scalar

[Paul Richard Thomas via Fortran]

Hi All,

This is another PDT warm-up patch before tackling the real beast: PR82649.

As the contributor wrote in the PR, "The F08 standard clearly distinguishes
between type parameter definition statements and component definition
statements. See R425, R431, R435, and in particular see Note 6.7 which says
'It [array%a, for example] is scalar even if designator is an array.' "
gfortran was not making this distinction. The patch realises the fix by
lifting the code used for inquiry part references into a new function and
calling for PDT parameters and inquiry references. The arrayspec lbound is
used for 'start' now, rather than unity. In principle this should remove
the need to suppress bound checking. However, since this would be confusing
for the user to say the least of it, the suppression has been retained.

Bootstraps and regtests on FC33/x86_64. OK for 12- and 11-branches?

Cheers

Paul

Fortran: Make PDT LEN and KIND expressions always scalar [PR84119].

2021-04-20  Paul Thomas  <pa...@gcc.gnu.org>

gcc/fortran
PR fortran/84119
* resolve.c (reset_array_ref_to_scalar): New function.
(gfc_resolve_ref): Call it for PDT kind and len expressions.
Code for inquiry refs. moved to new function and replaced by a
call to it.

gcc/testsuite/
PR fortran/84119
* gfortran.dg/pdt_32.f03: New test.
* gfortran.dg/pdt_20.f03: Correct the third test to be against
a scalar instead of an array.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index dd4b26680e0..1571fa9d70c 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5254,12 +5254,46 @@ gfc_resolve_substring_charlen (gfc_expr *e)
 }
 
 
+/* Convert an array reference to an array element so that PDT KIND and LEN
+   or inquiry references are always scalar.  */
+
+static void
+reset_array_ref_to_scalar (gfc_expr *expr, gfc_ref *array_ref)
+{
+  gfc_expr *unity = gfc_get_int_expr (gfc_default_integer_kind, NULL, 1);
+  int dim;
+
+  array_ref->u.ar.type = AR_ELEMENT;
+  expr->rank = 0;
+  /* Suppress the runtime bounds 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]);
+
+      if (array_ref->u.ar.as && array_ref->u.ar.as->lower[dim])
+	array_ref->u.ar.start[dim]
+			= gfc_copy_expr (array_ref->u.ar.as->lower[dim]);
+      else
+	array_ref->u.ar.start[dim] = gfc_copy_expr (unity);
+
+      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]);
+    }
+  gfc_free_expr (unity);
+}
+
+
 /* Resolve subtype references.  */
 
 bool
 gfc_resolve_ref (gfc_expr *expr)
 {
-  int current_part_dimension, n_components, seen_part_dimension, dim;
+  int current_part_dimension, n_components, seen_part_dimension;
   gfc_ref *ref, **prev, *array_ref;
   bool equal_length;
 
@@ -5365,6 +5399,14 @@ gfc_resolve_ref (gfc_expr *expr)
 		}
 	    }
 
+	  /* The F08 standard distinguishes between type parameter definition
+	     statements and component definition statements. See R425, R431,
+	     R435, and in particular see Note 6.7 which says "It [array%a, for
+	     example] is scalar even if designator is an array."  */
+	  if (array_ref && (ref->u.c.component->attr.pdt_kind
+			    || ref->u.c.component->attr.pdt_len))
+	    reset_array_ref_to_scalar (expr, array_ref);
+
 	  n_components++;
 	  break;
 
@@ -5375,27 +5417,7 @@ gfc_resolve_ref (gfc_expr *expr)
 	  /* 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 && expr->ts.deferred)
-	    {
-	      array_ref->u.ar.type = AR_ELEMENT;
-	      expr->rank = 0;
-	      /* INQUIRY_LEN is not evaluated from 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]);
-		}
-	    }
+	    reset_array_ref_to_scalar (expr, array_ref);
 	  break;
 	}
 
diff --git a/gcc/testsuite/gfortran.dg/pdt_20.f03 b/gcc/testsuite/gfortran.dg/pdt_20.f03
index b712ed59dbb..3aa9b2e086b 100644
--- a/gcc/testsuite/gfortran.dg/pdt_20.f03
+++ b/gcc/testsuite/gfortran.dg/pdt_20.f03
@@ -16,5 +16,5 @@ program p
    allocate (t2(3) :: x)            ! Used to segfault in trans-array.c.
    if (x%b .ne. 3) STOP 1
    if (x%b .ne. size (x%r, 1)) STOP 2
-   if (any (x%r%a .ne. 1)) STOP 3
+   if (x%r%a .ne. 1) STOP 3
 end

pdt_32.f03
Description: Binary data