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

[Paul Richard Thomas]

Hi All,

This patch corrects the current behaviour of gfortran to return arrays for
type parameter references, when the designator is an array. It reuses
existing code, as described in the ChangeLog. The necessary modification to
pdt_20.f03 is a sufficient test.

Regtests on FC42/x86_64. OK for mainline?

Paul

Change.Logs
Description: Binary data

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index d51301aec44..bd0e6e9f540 100644
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5871,13 +5871,47 @@ gfc_resolve_substring_charlen (gfc_expr *e)
   gfc_resolve_expr (e->ts.u.cl->length);
 }
 
+ 
+/* 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;
   gfc_symbol *last_pdt = NULL;
@@ -6021,6 +6055,15 @@ gfc_resolve_ref (gfc_expr *expr)
 	      else
 		last_pdt = NULL;
 	    }
+ 
+	  /* 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 && last_pdt && last_pdt->attr.pdt_type
+	      && (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;
@@ -6034,27 +6077,7 @@ gfc_resolve_ref (gfc_expr *expr)
 	  if (ref->u.i == INQUIRY_LEN && array_ref
 	      && ((expr->ts.type == BT_CHARACTER && !expr->ts.u.cl->length)
 		  || expr->ts.type == BT_INTEGER))
-	    {
-	      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