Fortran: Implement correct form of PDT constructors [PR84119]

2025-09-06  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran
	PR fortran/84119
	* resolve.cc (reset_array_ref_to_scalar): New function using
	chunk broken out from gfc_resolve_ref.
	(gfc_resolve_ref): Call the new function, the first time for
	PDT type parameters and the second time for LEN inquiry refs.

gcc/testsuite/
	PR fortran/84119
	* gfortran.dg/pdt_20.f03: Modify to deal with scalar type parm.

diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc
index d51301aec44fa0ab54da12ee22f4a72cad912e26..1a7c9dddb15ba4ec669be9345cce472b8a21dcc2 100644 (file)
--- a/gcc/fortran/resolve.cc
+++ b/gcc/fortran/resolve.cc
@@ -5872,12 +5872,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;
   gfc_symbol *last_pdt = NULL;
@@ -6022,6 +6056,14 @@ gfc_resolve_ref (gfc_expr *expr)
                last_pdt = NULL;
            }
 
+         /* The F08 standard requires(See R425, R431, R435, and in particular
+            Note 6.7) that a PDT parameter reference be a scalar even if 
+            the 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 +6076,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 b712ed59dbb07b2089e9bda75fd9a174fdf41d36..3aa9b2e086b83517154fb7324502f12c482dd868 100644 (file)
--- 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