Merge from trunk revision 104c05c5284b7822d770ee51a7d91946c7e56d50.

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;