Fortran: Assumed and explicit size class arrays [PR46691/99819].

2021-05-06  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran/ChangeLog

	PR fortran/46691
	PR fortran/99819
	* class.c (gfc_build_class_symbol): Remove the error that
	disables assumed size class arrays. Class array types that are
	not deferred shape or assumed rank are given a unique name and
	placed in the procedure namespace.
	* trans-array.c (gfc_trans_g77_array): Obtain the data pointer
	for class arrays.
	(gfc_trans_dummy_array_bias): Suppress the runtime error for
	extent violations in explicit shape class arrays because it
	always fails.
	* trans-expr.c (gfc_conv_procedure_call): Handle assumed size
	class actual arguments passed to non-descriptor formal args by
	using the data pointer, stored as the symbol's backend decl.

gcc/testsuite/ChangeLog

	PR fortran/46691
	PR fortran/99819
	* gfortran.dg/class_dummy_6.f90: New test.
	* gfortran.dg/class_dummy_7.f90: New test.

1 files changed, 25 insertions, 8 deletions

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 8935321..93118ad 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -630,6 +630,7 @@ gfc_get_len_component (gfc_expr *e, int k)
    component '_vptr' which determines the dynamic type.  When this CLASS
    entity is unlimited polymorphic, then also add a component '_len' to
    store the length of string when that is stored in it.  */
+static int ctr = 0;
 
 bool
 gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
@@ -645,13 +646,6 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
 
   gcc_assert (as);
 
-  if (*as && (*as)->type == AS_ASSUMED_SIZE)
-    {
-      gfc_error ("Assumed size polymorphic objects or components, such "
-		 "as that at %C, have not yet been implemented");
-      return false;
-    }
-
   if (attr->class_ok)
     /* Class container has already been built.  */
     return true;
@@ -693,7 +687,30 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
   else
     ns = ts->u.derived->ns;
 
-  gfc_find_symbol (name, ns, 0, &fclass);
+  /* Although this might seem to be counterintuitive, we can build separate
+     class types with different array specs because the TKR interface checks
+     work on the declared type. All array type other than deferred shape or
+     assumed rank are added to the function namespace to ensure that they
+     are properly distinguished.  */
+  if (attr->dummy && !attr->codimension && (*as)
+      && !((*as)->type == AS_DEFERRED || (*as)->type == AS_ASSUMED_RANK))
+    {
+      char *sname;
+      ns = gfc_current_ns;
+      gfc_find_symbol (name, ns, 0, &fclass);
+      /* If a local class type with this name already exists, update the
+	 name with an index.  */
+      if (fclass)
+	{
+	  fclass = NULL;
+	  sname = xasprintf ("%s_%d", name, ++ctr);
+	  free (name);
+	  name = sname;
+	}
+    }
+  else
+    gfc_find_symbol (name, ns, 0, &fclass);
+
   if (fclass == NULL)
     {
       gfc_symtree *st;