Update copyright years.

[thirdparty/gcc.git] / gcc / fortran / class.c

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 2eae7f0f3515f8af237627625a9a038c966f9e07..45fd5cbecaa2f3e727744cc821b608c8dc435624 100644 (file)
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -1,5 +1,5 @@
 /* Implementation of Fortran 2003 Polymorphism.
-   Copyright (C) 2009-2018 Free Software Foundation, Inc.
+   Copyright (C) 2009-2020 Free Software Foundation, Inc.
    Contributed by Paul Richard Thomas <pault@gcc.gnu.org>
    and Janus Weil <janus@gcc.gnu.org>
 
@@ -72,14 +72,18 @@ along with GCC; see the file COPYING3.  If not see
 static void
 insert_component_ref (gfc_typespec *ts, gfc_ref **ref, const char * const name)
 {
-  gfc_symbol *type_sym;
   gfc_ref *new_ref;
+  int wcnt, ecnt;
 
   gcc_assert (ts->type == BT_DERIVED || ts->type == BT_CLASS);
-  type_sym = ts->u.derived;
 
-  gfc_find_component (type_sym, name, true, true, &new_ref);
+  gfc_find_component (ts->u.derived, name, true, true, &new_ref);
+
+  gfc_get_errors (&wcnt, &ecnt);
+  if (ecnt > 0 && !new_ref)
+    return;
   gcc_assert (new_ref->u.c.component);
+
   while (new_ref->next)
     new_ref = new_ref->next;
   new_ref->next = *ref;
@@ -561,7 +565,7 @@ gfc_intrinsic_hash_value (gfc_typespec *ts)
    ref to the _len component.  */
 
 gfc_expr *
-gfc_get_len_component (gfc_expr *e)
+gfc_get_len_component (gfc_expr *e, int k)
 {
   gfc_expr *ptr;
   gfc_ref *ref, **last;
@@ -586,6 +590,14 @@ gfc_get_len_component (gfc_expr *e)
     }
   /* And replace if with a ref to the _len component.  */
   gfc_add_len_component (ptr);
+  if (k != ptr->ts.kind)
+    {
+      gfc_typespec ts;
+      gfc_clear_ts (&ts);
+      ts.type = BT_INTEGER;
+      ts.kind = k;
+      gfc_convert_type_warn (ptr, &ts, 2, 0);
+    }
   return ptr;
 }
 
@@ -626,7 +638,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
                   || attr->select_type_temporary || attr->associate_var;
 
   if (!attr->class_ok)
-    /* We can not build the class container yet.  */
+    /* We cannot build the class container yet.  */
     return true;
 
   /* Determine the name of the encapsulating type.  */
@@ -899,6 +911,9 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
   if (!comp_is_finalizable (comp))
     return;
 
+  if (comp->finalized)
+    return;
+
   e = gfc_copy_expr (expr);
   if (!e->ref)
     e->ref = ref = gfc_get_ref ();
@@ -1026,6 +1041,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
                            sub_ns);
       gfc_free_expr (e);
     }
+  comp->finalized = true;
 }
 
 
@@ -2225,6 +2241,9 @@ gfc_find_derived_vtab (gfc_symbol *derived)
   if (!derived->attr.unlimited_polymorphic && derived->attr.is_class)
     derived = gfc_get_derived_super_type (derived);
 
+  if (!derived)
+    return NULL;
+
   /* Find the gsymbol for the module of use associated derived types.  */
   if ((derived->attr.use_assoc || derived->attr.used_in_submodule)
        && !derived->attr.vtype && !derived->attr.is_class)
@@ -2462,6 +2481,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
                goto cleanup;
              c->attr.proc_pointer = 1;
              c->attr.access = ACCESS_PRIVATE;
+             c->attr.artificial = 1;
              c->tb = XCNEW (gfc_typebound_proc);
              c->tb->ppc = 1;
              generate_finalization_wrapper (derived, ns, tname, c);
@@ -2661,6 +2681,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
              gfc_namespace *sub_ns;
              gfc_namespace *contained;
              gfc_expr *e;
+             size_t e_size;
 
              gfc_get_symbol (name, ns, &vtype);
              if (!gfc_add_flavor (&vtype->attr, FL_DERIVED, NULL,
@@ -2695,11 +2716,13 @@ find_intrinsic_vtab (gfc_typespec *ts)
              e = gfc_get_expr ();
              e->ts = *ts;
              e->expr_type = EXPR_VARIABLE;
+             if (ts->type == BT_CHARACTER)
+               e_size = ts->kind;
+             else
+               gfc_element_size (e, &e_size);
              c->initializer = gfc_get_int_expr (gfc_size_kind,
                                                 NULL,
-                                                ts->type == BT_CHARACTER
-                                                ? ts->kind
-                                                : gfc_element_size (e));
+                                                e_size);
              gfc_free_expr (e);
 
              /* Add component _extends.  */
@@ -2758,9 +2781,9 @@ find_intrinsic_vtab (gfc_typespec *ts)
              /* This is elemental so that arrays are automatically
                 treated correctly by the scalarizer.  */
              copy->attr.elemental = 1;
-             if (ns->proc_name->attr.flavor == FL_MODULE)
+             if (ns->proc_name && ns->proc_name->attr.flavor == FL_MODULE)
                copy->module = ns->proc_name->name;
-                 gfc_set_sym_referenced (copy);
+             gfc_set_sym_referenced (copy);
              /* Set up formal arguments.  */
              gfc_get_symbol ("src", sub_ns, &src);
              src->ts.type = ts->type;
@@ -2794,6 +2817,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
                goto cleanup;
              c->attr.proc_pointer = 1;
              c->attr.access = ACCESS_PRIVATE;
+             c->attr.artificial = 1;
              c->tb = XCNEW (gfc_typebound_proc);
              c->tb->ppc = 1;
              c->initializer = gfc_get_null_expr (NULL);
@@ -2840,7 +2864,10 @@ gfc_find_vtab (gfc_typespec *ts)
     case BT_DERIVED:
       return gfc_find_derived_vtab (ts->u.derived);
     case BT_CLASS:
-      return gfc_find_derived_vtab (ts->u.derived->components->ts.u.derived);
+      if (ts->u.derived->components && ts->u.derived->components->ts.u.derived)
+       return gfc_find_derived_vtab (ts->u.derived->components->ts.u.derived);
+      else
+       return NULL;
     default:
       return find_intrinsic_vtab (ts);
     }