diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 2235b52..b3f5984 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -2801,7 +2801,7 @@ gfc_check_move_alloc (gfc_expr *from, gfc_expr *to)
 
   /* CLASS arguments: Make sure the vtab of from is present.  */
   if (to->ts.type == BT_CLASS)
-    gfc_find_derived_vtab (from->ts.u.derived);
+    gfc_get_derived_vtab (from->ts.u.derived);
 
   return SUCCESS;
 }
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index dca2cfc..675b810 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -416,7 +416,7 @@ gfc_class_null_initializer (gfc_typespec *ts)
     {
       gfc_constructor *ctor = gfc_constructor_get();
       if (strcmp (comp->name, "_vptr") == 0)
-	ctor->expr = gfc_lval_expr_from_sym (gfc_find_derived_vtab (ts->u.derived));
+	ctor->expr = gfc_lval_expr_from_sym (gfc_get_derived_vtab (ts->u.derived));
       else
 	ctor->expr = gfc_get_null_expr (NULL);
       gfc_constructor_append (&init->value.constructor, ctor);
@@ -454,7 +454,7 @@ get_unique_hashed_string (char *string, gfc_symbol *derived)
   char tmp[2*GFC_MAX_SYMBOL_LEN+2];
   get_unique_type_string (&tmp[0], derived);
   /* If string is too long, use hash value in hex representation (allow for
-     extra decoration, cf. gfc_build_class_symbol & gfc_find_derived_vtab).
+     extra decoration, cf. gfc_build_class_symbol & gfc_get_derived_vtab).
      We need space to for 15 characters "__class_" + symbol name + "_%d_%da",
      where %d is the (co)rank which can be up to n = 15.  */
   if (strlen (tmp) > GFC_MAX_SYMBOL_LEN - 15)
@@ -581,7 +581,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
 	c->ts.u.derived = NULL;
       else
 	{
-	  vtab = gfc_find_derived_vtab (ts->u.derived);
+	  vtab = gfc_get_derived_vtab (ts->u.derived);
 	  gcc_assert (vtab);
 	  c->ts.u.derived = vtab->ts.u.derived;
 	}
@@ -682,7 +682,7 @@ copy_vtab_proc_comps (gfc_symbol *declared, gfc_symbol *vtype)
   gfc_component *cmp;
   gfc_symbol *vtab;
 
-  vtab = gfc_find_derived_vtab (declared);
+  vtab = gfc_get_derived_vtab (declared);
 
   for (cmp = vtab->ts.u.derived->components; cmp; cmp = cmp->next)
     {
@@ -809,7 +809,7 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
       gfc_symbol *vtab;
       gfc_component *c;
 
-      vtab = gfc_find_derived_vtab (comp->ts.u.derived);
+      vtab = gfc_get_derived_vtab (comp->ts.u.derived);
       for (c = vtab->ts.u.derived->components; c; c = c->next)
 	if (strcmp (c->name, "_final") == 0)
 	  break;
@@ -982,7 +982,7 @@ static void
 generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
 			       const char *tname, gfc_component *vtab_final)
 {
-  gfc_symbol *final, *array, *nelem;
+  gfc_symbol *final, *array, *nelem, *skip_coarray;
   gfc_symbol *ptr = NULL, *idx = NULL;
   gfc_component *comp;
   gfc_namespace *sub_ns;
@@ -999,7 +999,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
       gfc_symbol *vtab;
       gfc_component *comp;
 
-      vtab = gfc_find_derived_vtab (derived->components->ts.u.derived);
+      vtab = gfc_get_derived_vtab (derived->components->ts.u.derived);
       for (comp = vtab->ts.u.derived->components; comp; comp = comp->next)
 	if (comp->name[0] == '_' && comp->name[1] == 'f')
 	  {
@@ -1016,6 +1016,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
       && !has_finalizer_component (derived))
     {
       vtab_final->initializer = gfc_get_null_expr (NULL);
+/* FIXME:  Something like vtab_final->ts.interface = final; is needed! */
       return;
     }
 
@@ -1042,6 +1043,10 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
       && !finalizable_comp)
     {
       vtab_final->initializer = gfc_copy_expr (ancestor_wrapper);
+      if (vtab_final->initializer->expr_type == EXPR_NULL)
+/*	vtab_final->ts.interface = final;
+      else    FIXME - does the following always work? */
+	gfc_get_proc_ptr_comp (final_expr)->ts.interface 
       return;
     }
 
@@ -1054,7 +1059,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
      3. Call the ancestor's finalizer.  */
 
   /* Declare the wrapper function; it takes an assumed-rank array
-     as argument. */
+     and a VALUE logical as arguments. */
 
   /* Set up the namespace.  */
   sub_ns = gfc_get_namespace (ns, 0);
@@ -1067,8 +1072,11 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
   gfc_get_symbol (name, sub_ns, &final);
   sub_ns->proc_name = final;
   final->attr.flavor = FL_PROCEDURE;
-  final->attr.subroutine = 1;
-  final->attr.pure = 1;
+  final->attr.function = 1;
+  final->attr.pure = 0;
+  final->result = final;
+  final->ts.type = BT_INTEGER;
+  final->ts.kind = 4;
   final->attr.artificial = 1;
   final->attr.if_source = IFSRC_DECL;
   if (ns->proc_name->attr.flavor == FL_MODULE)
@@ -1093,6 +1101,27 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
   final->formal->sym = array;
   gfc_commit_symbol (array);
 
+  /* Set up formal argument.  */
+  gfc_get_symbol ("skip_coarray", sub_ns, &skip_coarray);
+  skip_coarray->ts.type = BT_LOGICAL;
+  skip_coarray->ts.kind = 4;
+  skip_coarray->attr.flavor = FL_VARIABLE;
+  skip_coarray->attr.dummy = 1;
+  skip_coarray->attr.value = 1;
+  skip_coarray->attr.artificial = 1;
+  gfc_set_sym_referenced (skip_coarray);
+  final->formal->next = gfc_get_formal_arglist ();
+  final->formal->next->sym = skip_coarray;
+  gfc_commit_symbol (skip_coarray);
+
+  /* Set return value to 0.  */
+  last_code = XCNEW (gfc_code);
+  last_code->op = EXEC_ASSIGN;
+  last_code->loc = gfc_current_locus;
+  last_code->expr1 = gfc_lval_expr_from_sym (final);
+  last_code->expr2 = gfc_get_int_expr (4, NULL, 0);
+  sub_ns->code = last_code;
+
   /* Obtain the size (number of elements) of "array" MINUS ONE,
      which is used in the scalarization.  */
   gfc_get_symbol ("nelem", sub_ns, &nelem);
@@ -1104,7 +1133,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
   gfc_commit_symbol (nelem);
 
   /* Generate: nelem = SIZE (array) - 1.  */
-  last_code = XCNEW (gfc_code);
+  last_code->next = XCNEW (gfc_code);
+  last_code = last_code->next;
   last_code->op = EXEC_ASSIGN;
   last_code->loc = gfc_current_locus;
 
@@ -1383,6 +1413,8 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
 
       last_code->ext.actual = gfc_get_actual_arglist ();
       last_code->ext.actual->expr = gfc_lval_expr_from_sym (array);
+      last_code->ext.actual->next = gfc_get_actual_arglist ();
+      last_code->ext.actual->next->expr = gfc_lval_expr_from_sym (skip_coarray);
     }
 
   gfc_commit_symbol (final);
@@ -1416,10 +1448,10 @@ add_procs_to_declared_vtab (gfc_symbol *derived, gfc_symbol *vtype)
 }
 
 
-/* Find (or generate) the symbol for a derived type's vtab.  */
+/* Find or generate the symbol for a derived type's vtab.  */
 
-gfc_symbol *
-gfc_find_derived_vtab (gfc_symbol *derived)
+static gfc_symbol *
+find_derived_vtab (gfc_symbol *derived, bool generate)
 {
   gfc_namespace *ns;
   gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL, *def_init = NULL;
@@ -1437,7 +1469,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
   if (ns)
     {
       char name[GFC_MAX_SYMBOL_LEN+1], tname[GFC_MAX_SYMBOL_LEN+1];
-      
+
       get_unique_hashed_string (tname, derived);
       sprintf (name, "__vtab_%s", tname);
 
@@ -1448,7 +1480,9 @@ gfc_find_derived_vtab (gfc_symbol *derived)
       if (vtab == NULL)
 	gfc_find_symbol (name, derived->ns, 0, &vtab);
 
-      if (vtab == NULL)
+      if (!generate && !vtab)
+       return NULL;
+
 	{
 	  gfc_get_symbol (name, ns, &vtab);
 	  vtab->ts.type = BT_DERIVED;
@@ -1461,7 +1495,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 	  vtab->attr.access = ACCESS_PUBLIC;
 	  gfc_set_sym_referenced (vtab);
 	  sprintf (name, "__vtype_%s", tname);
-	  
+
 	  gfc_find_symbol (name, ns, 0, &vtype);
 	  if (vtype == NULL)
 	    {
@@ -1506,7 +1540,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 	      parent = gfc_get_derived_super_type (derived);
 	      if (parent)
 		{
-		  parent_vtab = gfc_find_derived_vtab (parent);
+		  parent_vtab = gfc_get_derived_vtab (parent);
 		  c->ts.type = BT_DERIVED;
 		  c->ts.u.derived = parent_vtab->ts.u.derived;
 		  c->initializer = gfc_get_expr ();
@@ -1624,9 +1658,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 		 components and the calls to finalization subroutines.
 		 Note: The actual wrapper function can only be generated
 		 at resolution time.  */
-	    /* FIXME: Enable ABI-breaking "_final" generation.  */
-	    if (0) 
-	    {
 	      if (gfc_add_component (vtype, "_final", &c) == FAILURE)
 		goto cleanup;
 	      c->attr.proc_pointer = 1;
@@ -1634,7 +1665,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 	      c->tb = XCNEW (gfc_typebound_proc);
 	      c->tb->ppc = 1;
 	      generate_finalization_wrapper (derived, ns, tname, c);
-	    }
 
 	      /* Add procedure pointers for type-bound procedures.  */
 	      add_procs_to_declared_vtab (derived, vtype);
@@ -1672,6 +1702,20 @@ cleanup:
 }
 
 
+gfc_symbol *
+gfc_find_derived_vtab (gfc_symbol *derived)
+{
+  return find_derived_vtab (derived, false);
+}
+
+
+gfc_symbol *
+gfc_get_derived_vtab (gfc_symbol *derived)
+{
+  return find_derived_vtab (derived, true);
+}
+
+
 /* General worker function to find either a type-bound procedure or a
    type-bound user operator.  */
 
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index bc1f5e3..1a9772a 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -3552,7 +3552,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue)
 
   if (lvalue->ts.type == BT_CLASS && rvalue->ts.type == BT_DERIVED)
     /* Make sure the vtab is present.  */
-    gfc_find_derived_vtab (rvalue->ts.u.derived);
+    gfc_get_derived_vtab (rvalue->ts.u.derived);
 
   /* Check rank remapping.  */
   if (rank_remap)
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index b3224aa..a6f501f 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -2956,6 +2956,7 @@ unsigned int gfc_hash_value (gfc_symbol *);
 gfc_try gfc_build_class_symbol (gfc_typespec *, symbol_attribute *,
 				gfc_array_spec **, bool);
 gfc_symbol *gfc_find_derived_vtab (gfc_symbol *);
+gfc_symbol *gfc_get_derived_vtab (gfc_symbol *);
 gfc_symtree* gfc_find_typebound_proc (gfc_symbol*, gfc_try*,
 				      const char*, bool, locus*);
 gfc_symtree* gfc_find_typebound_user_op (gfc_symbol*, gfc_try*,
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 482c294..154b227 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -1825,7 +1825,7 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
   if (formal->ts.type == BT_CLASS && actual->ts.type == BT_DERIVED)
     /* Make sure the vtab symbol is present when
        the module variables are generated.  */
-    gfc_find_derived_vtab (actual->ts.u.derived);
+    gfc_get_derived_vtab (actual->ts.u.derived);
 
   if (actual->ts.type == BT_PROCEDURE)
     {
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 3f981d8..83a896a 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -945,7 +945,7 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo)
     gfc_add_vptr_component (a);
   else if (a->ts.type == BT_DERIVED)
     {
-      vtab = gfc_find_derived_vtab (a->ts.u.derived);
+      vtab = gfc_get_derived_vtab (a->ts.u.derived);
       /* Clear the old expr.  */
       gfc_free_ref_list (a->ref);
       memset (a, '\0', sizeof (gfc_expr));
@@ -961,7 +961,7 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo)
     gfc_add_vptr_component (mo);
   else if (mo->ts.type == BT_DERIVED)
     {
-      vtab = gfc_find_derived_vtab (mo->ts.u.derived);
+      vtab = gfc_get_derived_vtab (mo->ts.u.derived);
       /* Clear the old expr.  */
       gfc_free_ref_list (mo->ref);
       memset (mo, '\0', sizeof (gfc_expr));
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 28eea5d..c74ee75 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -6187,7 +6187,7 @@ resolve_typebound_function (gfc_expr* e)
       declared = ts.u.derived;
       c = gfc_find_component (declared, "_vptr", true, true);
       if (c->ts.u.derived == NULL)
-	c->ts.u.derived = gfc_find_derived_vtab (declared);
+	c->ts.u.derived = gfc_get_derived_vtab (declared);
 
       if (resolve_compcall (e, &name) == FAILURE)
 	return FAILURE;
@@ -6312,7 +6312,7 @@ resolve_typebound_subroutine (gfc_code *code)
       declared = expr->ts.u.derived;
       c = gfc_find_component (declared, "_vptr", true, true);
       if (c->ts.u.derived == NULL)
-	c->ts.u.derived = gfc_find_derived_vtab (declared);
+	c->ts.u.derived = gfc_get_derived_vtab (declared);
 
       if (resolve_typebound_call (code, &name) == FAILURE)
 	return FAILURE;
@@ -7333,7 +7333,7 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 	ts = code->expr3->ts;
       else if (code->ext.alloc.ts.type == BT_DERIVED)
 	ts = code->ext.alloc.ts;
-      gfc_find_derived_vtab (ts.u.derived);
+      gfc_get_derived_vtab (ts.u.derived);
       if (dimension)
 	e = gfc_expr_to_initialize (e);
     }
@@ -8522,7 +8522,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns)
 	  new_st->expr1->value.function.actual->expr = gfc_get_variable_expr (code->expr1->symtree);
 	  new_st->expr1->value.function.actual->expr->where = code->loc;
 	  gfc_add_vptr_component (new_st->expr1->value.function.actual->expr);
-	  vtab = gfc_find_derived_vtab (body->ext.block.case_list->ts.u.derived);
+	  vtab = gfc_get_derived_vtab (body->ext.block.case_list->ts.u.derived);
 	  st = gfc_find_symtree (vtab->ns->sym_root, vtab->name);
 	  new_st->expr1->value.function.actual->next = gfc_get_actual_arglist ();
 	  new_st->expr1->value.function.actual->next->expr = gfc_get_variable_expr (st);
@@ -11218,11 +11218,7 @@ error:
 		 " defined at %L, suggest also scalar one",
 		 derived->name, &derived->declared_at);
 
-  /* TODO:  Remove this error when finalization is finished.  */
-  gfc_error ("Finalization at %L is not yet implemented",
-	     &derived->declared_at);
-
-  gfc_find_derived_vtab (derived);
+  gfc_get_derived_vtab (derived);
   return result;
 }
 
@@ -11782,7 +11778,7 @@ resolve_typebound_procedures (gfc_symbol* derived)
   resolve_bindings_result = SUCCESS;
 
   /* Make sure the vtab has been generated.  */
-  gfc_find_derived_vtab (derived);
+  gfc_get_derived_vtab (derived);
 
   if (derived->f2k_derived->tb_sym_root)
     gfc_traverse_symtree (derived->f2k_derived->tb_sym_root,
@@ -12336,7 +12332,7 @@ resolve_fl_derived (gfc_symbol *sym)
       gfc_component *vptr = gfc_find_component (sym, "_vptr", true, true);
       if (vptr->ts.u.derived == NULL)
 	{
-	  gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived);
+	  gfc_symbol *vtab = gfc_get_derived_vtab (data->ts.u.derived);
 	  gcc_assert (vtab);
 	  vptr->ts.u.derived = vtab->ts.u.derived;
 	}
@@ -12548,6 +12544,9 @@ resolve_symbol (gfc_symbol *sym)
   if (sym->attr.artificial)
     return;
 
+  if (sym->attr.artificial)
+    return;
+
   if (sym->attr.flavor == FL_UNKNOWN
       || (sym->attr.flavor == FL_PROCEDURE && !sym->attr.intrinsic
 	  && !sym->attr.generic && !sym->attr.external
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index c350c3b..8b36800 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -7587,7 +7587,7 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
 					CLASS_DATA (c)->attr.codimension);
 	      else
 		{
-		  tmp = gfc_deallocate_scalar_with_status (comp, NULL, true, NULL,
+		  tmp = gfc_deallocate_scalar_with_status (comp, NULL_TREE, true, NULL,
 							   CLASS_DATA (c)->ts);
 		  gfc_add_expr_to_block (&tmpblock, tmp);
 		  called_dealloc_with_status = true;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 7e59cb6..77dee30 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1211,7 +1211,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
       gfc_component *c = CLASS_DATA (sym);
       if (!c->ts.u.derived->backend_decl)
 	{
-	  gfc_find_derived_vtab (c->ts.u.derived);
+	  gfc_get_derived_vtab (c->ts.u.derived);
 	  gfc_get_derived_type (sym->ts.u.derived);
 	}
     }
@@ -3439,7 +3439,51 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 	&& !f->sym->attr.pointer
 	&& f->sym->ts.type == BT_DERIVED)
       {
-	if (f->sym->ts.u.derived->attr.alloc_comp && !f->sym->value)
+	gfc_symbol *vtab = gfc_find_derived_vtab (f->sym->ts.u.derived);
+	gfc_expr *final_expr = NULL;
+
+	if (vtab)
+	  {
+	    gfc_component *final;
+
+	    final = vtab->ts.u.derived->components->next->next->next->next->next;
+	    gcc_assert (strcmp (final->name, "_final") == 0);
+
+	    if (final->initializer && final->initializer->expr_type != EXPR_NULL)
+	      final_expr = final->initializer;
+	  }
+
+	if (final_expr)
+	  {
+	    gfc_code *code;
+
+	    f->sym->attr.referenced = 1;
+	    code = gfc_get_code ();
+	    code->resolved_sym = gfc_get_proc_ptr_comp (final_expr)->ts.interface;
+	    code->ext.actual = gfc_get_actual_arglist ();
+	    code->ext.actual->expr = gfc_lval_expr_from_sym (f->sym);
+	    code->ext.actual->next = gfc_get_actual_arglist ();
+	    code->ext.actual->next->expr = gfc_get_logical_expr (4, NULL, false);
+	    code->expr1 = gfc_copy_expr (final_expr);
+	    code->op = EXEC_CALL;
+	    tmp = gfc_trans_call (code, true, NULL, NULL, false);
+
+	    if (f->sym->attr.optional
+		|| f->sym->ns->proc_name->attr.entry_master)
+	      {
+		present = gfc_conv_expr_present (f->sym);
+		tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
+				  present, tmp,
+				  build_empty_stmt (input_location));
+	      }
+
+	    gfc_add_expr_to_block (&init, tmp);
+	    gfc_free_statements (code);
+
+	    if (f->sym->value)
+	      gfc_init_default_dt (f->sym, &init, false);
+	  }
+	else if (f->sym->ts.u.derived->attr.alloc_comp && !f->sym->value)
 	  {
 	    tmp = gfc_deallocate_alloc_comp (f->sym->ts.u.derived,
 					     f->sym->backend_decl,
@@ -3461,25 +3505,44 @@ init_intent_out_dt (gfc_symbol * proc_sym, gfc_wrapped_block * block)
       }
     else if (f->sym && f->sym->attr.intent == INTENT_OUT
 	     && f->sym->ts.type == BT_CLASS
-	     && !CLASS_DATA (f->sym)->attr.class_pointer
-	     && CLASS_DATA (f->sym)->ts.u.derived->attr.alloc_comp)
+	     && !CLASS_DATA (f->sym)->attr.class_pointer)
       {
-	tmp = gfc_class_data_get (f->sym->backend_decl);
+	gfc_expr *final_expr = NULL;
+	gfc_code *code;
+	tree cond;
+
+	/* Make sure the vtab is available.  */
+	gfc_get_derived_vtab (f->sym->ts.u.derived);
+	final_expr = gfc_lval_expr_from_sym (f->sym);
+	gfc_add_vptr_component (final_expr);
+	gfc_add_component_ref (final_expr, "_final");
+
+	f->sym->attr.referenced = 1;
+	code = gfc_get_code ();
+	code->resolved_sym = gfc_get_proc_ptr_comp (final_expr)->ts.interface;
+	code->ext.actual = gfc_get_actual_arglist ();
+	code->ext.actual->expr = gfc_lval_expr_from_sym (f->sym);
+	code->ext.actual->next = gfc_get_actual_arglist ();
+	code->ext.actual->next->expr = gfc_get_logical_expr (4, NULL, false);
+	code->expr1 = gfc_copy_expr (final_expr);
+	code->op = EXEC_CALL;
+	tmp = gfc_trans_call (code, true, NULL, NULL, false);
+
+	cond = gfc_class_data_get (f->sym->backend_decl);
 	if (CLASS_DATA (f->sym)->as == NULL)
-	  tmp = build_fold_indirect_ref_loc (input_location, tmp);
-	tmp = gfc_deallocate_alloc_comp (CLASS_DATA (f->sym)->ts.u.derived,
-					 tmp,
-					 CLASS_DATA (f->sym)->as ?
-					 CLASS_DATA (f->sym)->as->rank : 0);
+	  cond = gfc_build_addr_expr (NULL_TREE, cond);
+	cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				cond, build_int_cst (TREE_TYPE (cond), 0));
 
 	if (f->sym->attr.optional || f->sym->ns->proc_name->attr.entry_master)
 	  {
 	    present = gfc_conv_expr_present (f->sym);
-	    tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
-			      present, tmp,
-			      build_empty_stmt (input_location));
+	    cond = fold_build2_loc (input_location, TRUTH_ANDIF_EXPR,
+				    boolean_type_node, present, cond);
 	  }
 
+	tmp = build3_loc (input_location, COND_EXPR, TREE_TYPE (tmp),
+			      cond, tmp, build_empty_stmt (input_location));
 	gfc_add_expr_to_block (&init, tmp);
       }
 
@@ -3789,14 +3852,15 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
 						      NULL_TREE, true, NULL,
 						      true);
 		  else
-		    tmp = gfc_deallocate_scalar_with_status (se.expr, NULL,
-							     true, NULL,
-							     sym->ts);
+		    tmp = gfc_deallocate_scalar_with_status (se.expr, NULL_TREE,
+						   true,
+						   gfc_lval_expr_from_sym (sym),
+						   sym->ts);
 		}
 	      if (sym->ts.type == BT_CLASS)
 		{
 		  /* Initialize _vptr to declared type.  */
-		  gfc_symbol *vtab = gfc_find_derived_vtab (sym->ts.u.derived);
+		  gfc_symbol *vtab = gfc_get_derived_vtab (sym->ts.u.derived);
 		  tree rhs;
 
 		  gfc_save_backend_locus (&loc);
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 84a4b34..b6809b49 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -95,6 +95,7 @@ conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr)
 #define VTABLE_EXTENDS_FIELD 2
 #define VTABLE_DEF_INIT_FIELD 3
 #define VTABLE_COPY_FIELD 4
+#define VTABLE_FINAL_FIELD 5
 
 
 tree
@@ -180,6 +181,13 @@ gfc_vtable_copy_get (tree decl)
 }
 
 
+tree
+gfc_vtable_final_get (tree decl)
+{
+  return gfc_vtable_field_get (decl, VTABLE_FINAL_FIELD);
+}
+
+
 #undef CLASS_DATA_FIELD
 #undef CLASS_VPTR_FIELD
 #undef VTABLE_HASH_FIELD
@@ -187,6 +195,7 @@ gfc_vtable_copy_get (tree decl)
 #undef VTABLE_EXTENDS_FIELD
 #undef VTABLE_DEF_INIT_FIELD
 #undef VTABLE_COPY_FIELD
+#undef VTABLE_FINAL_FIELD
 
 
 /* Obtain the vptr of the last class reference in an expression.  */
@@ -259,7 +268,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
     {
       /* In this case the vtab corresponds to the derived type and the
 	 vptr must point to it.  */
-      vtab = gfc_find_derived_vtab (e->ts.u.derived);
+      vtab = gfc_get_derived_vtab (e->ts.u.derived);
       gcc_assert (vtab);
       tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab));
     }
@@ -664,9 +673,9 @@ gfc_trans_class_assign (gfc_expr *expr1, gfc_expr *expr2, gfc_exec_op op)
       gfc_add_vptr_component (lhs);
 
       if (expr2->ts.type == BT_DERIVED)
-	vtab = gfc_find_derived_vtab (expr2->ts.u.derived);
+	vtab = gfc_get_derived_vtab (expr2->ts.u.derived);
       else if (expr2->expr_type == EXPR_NULL)
-	vtab = gfc_find_derived_vtab (expr1->ts.u.derived);
+	vtab = gfc_get_derived_vtab (expr1->ts.u.derived);
       gcc_assert (vtab);
 
       rhs = gfc_get_expr ();
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 4b268b3..2fdcb0f 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -7273,7 +7273,7 @@ conv_intrinsic_move_alloc (gfc_code *code)
 
       /* Deallocate "to".  */
       tmp = gfc_deallocate_scalar_with_status (to_se.expr, NULL_TREE, true,
-					       to_expr2, to_expr->ts);
+					       to_expr, to_expr->ts);
       gfc_add_expr_to_block (&block, tmp);
 
       /* Assign (_data) pointers.  */
@@ -7308,7 +7308,7 @@ conv_intrinsic_move_alloc (gfc_code *code)
 	  else
 	    {
 	      gfc_symbol *vtab;
-	      vtab = gfc_find_derived_vtab (from_expr->ts.u.derived);
+	      vtab = gfc_get_derived_vtab (from_expr->ts.u.derived);
 	      gcc_assert (vtab);
 	      tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab));
 	    }
@@ -7339,7 +7339,7 @@ conv_intrinsic_move_alloc (gfc_code *code)
       else
 	{
 	  gfc_symbol *vtab;
-	  vtab = gfc_find_derived_vtab (from_expr->ts.u.derived);
+	  vtab = gfc_get_derived_vtab (from_expr->ts.u.derived);
 	  gcc_assert (vtab);
 	  tmp = gfc_build_addr_expr (NULL_TREE, gfc_get_symbol_decl (vtab));
 	}
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 8bc4916..367a8ba 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5097,7 +5097,7 @@ gfc_trans_allocate (gfc_code * code)
 
 	      if (ts->type == BT_DERIVED)
 		{
-		  vtab = gfc_find_derived_vtab (ts->u.derived);
+		  vtab = gfc_get_derived_vtab (ts->u.derived);
 		  gcc_assert (vtab);
 		  gfc_init_se (&lse, NULL);
 		  lse.want_pointer = 1;
@@ -5182,10 +5182,11 @@ gfc_trans_allocate (gfc_code * code)
 		}
 	      else
 		ppc = gfc_lval_expr_from_sym
-				(gfc_find_derived_vtab (rhs->ts.u.derived));
+				(gfc_get_derived_vtab (rhs->ts.u.derived));
 	      gfc_add_component_ref (ppc, "_copy");
 
 	      ppc_code = gfc_get_code ();
+	      /* FIXME: Probably, the interface is not avilable, cf. _final ...*/
 	      ppc_code->resolved_sym = ppc->symtree->n.sym;
 	      /* Although '_copy' is set to be elemental in class.c, it is
 		 not staying that way.  Find out why, sometime....  */
@@ -5345,13 +5346,85 @@ gfc_trans_deallocate (gfc_code *code)
       gfc_init_se (&se, NULL);
       gfc_start_block (&se.pre);
 
+/* FIXME: HOW is var == NULL handled? And how are coarrays error stats handled? */
       se.want_pointer = 1;
       se.descriptor_only = 1;
       gfc_conv_expr (&se, expr);
 
       if (expr->rank || gfc_is_coarray (expr))
 	{
-	  if (expr->ts.type == BT_DERIVED && expr->ts.u.derived->attr.alloc_comp)
+	  gfc_expr *final_expr = NULL;
+	  gfc_code *code;
+
+	  if (al->expr->ts.type == BT_CLASS)
+	    {
+	      final_expr = gfc_copy_expr (al->expr);
+	      gfc_add_vptr_component (final_expr);
+	      gfc_add_component_ref (final_expr, "_final");
+	    }
+	  else if (al->expr->ts.type == BT_DERIVED)
+	    {
+	      gfc_symbol *vtab = gfc_find_derived_vtab (al->expr->ts.u.derived);
+	      if (vtab)
+		{
+		  gfc_component *final;
+		  final = vtab->ts.u.derived->components;
+		  final = final->next->next->next->next->next;
+		  gcc_assert (strcmp (final->name, "_final") == 0);
+
+		  if (final->initializer
+		      && final->initializer->expr_type != EXPR_NULL)
+		    final_expr = final->initializer;
+		}
+	    }
+
+	  if (final_expr)
+	    {
+	      tree cond;
+
+	      tmp = gfc_conv_descriptor_data_get (se.expr);
+	      STRIP_NOPS (se.expr);
+
+	      cond = fold_build2_loc (input_location, NE_EXPR,
+				      boolean_type_node, tmp,
+				      null_pointer_node);
+
+	      if (al->expr->ts.type == BT_CLASS)
+		{
+		  tree cond2;
+		  gfc_se se2;
+
+		  gfc_init_se (&se2, NULL);
+		  se2.want_pointer = 1;
+		  gfc_conv_expr (&se2, final_expr);
+		  cond2 = fold_build2_loc (input_location, NE_EXPR,
+					   boolean_type_node, se2.expr,
+					   build_int_cst (TREE_TYPE (se2.expr),
+							  0));
+		  cond = fold_build2_loc (input_location, TRUTH_AND_EXPR,
+					  boolean_type_node, cond, cond2);
+		}
+
+	      code = gfc_get_code ();
+	      code->resolved_sym = gfc_get_proc_ptr_comp (final_expr)->ts.interface;
+	      code->ext.actual = gfc_get_actual_arglist ();
+	      code->ext.actual->expr = gfc_copy_expr (expr);
+	      code->ext.actual->next = gfc_get_actual_arglist ();
+	      code->ext.actual->next->expr = gfc_get_logical_expr (4, NULL,
+								   false);
+	      code->expr1 = gfc_copy_expr (final_expr);
+	      code->op = EXEC_CALL;
+	      tmp = gfc_trans_call (code, true, NULL, NULL, false);
+
+	      tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+				     cond, tmp,
+				     build_empty_stmt (input_location));
+	      gfc_free_statements (code);
+	      gfc_add_expr_to_block (&se.pre, tmp);
+	    }
+
+	  if (!final_expr && expr->ts.type == BT_DERIVED
+	      && expr->ts.u.derived->attr.alloc_comp)
 	    {
 	      gfc_ref *ref;
 	      gfc_ref *last = NULL;
@@ -5376,7 +5449,7 @@ gfc_trans_deallocate (gfc_code *code)
       else
 	{
 	  tmp = gfc_deallocate_scalar_with_status (se.expr, pstat, false,
-						   expr, expr->ts);
+						   al->expr, al->expr->ts);
 	  gfc_add_expr_to_block (&se.pre, tmp);
 
 	  /* Set to zero after deallocation.  */
@@ -5389,7 +5462,7 @@ gfc_trans_deallocate (gfc_code *code)
 	    {
 	      /* Reset _vptr component to declared type.  */
 	      gfc_expr *rhs, *lhs = gfc_copy_expr (al->expr);
-	      gfc_symbol *vtab = gfc_find_derived_vtab (al->expr->ts.u.derived);
+	      gfc_symbol *vtab = gfc_get_derived_vtab (al->expr->ts.u.derived);
 	      gfc_add_vptr_component (lhs);
 	      rhs = gfc_lval_expr_from_sym (vtab);
 	      tmp = gfc_trans_pointer_assignment (lhs, rhs);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 3286a5a..798f866 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -2654,7 +2654,7 @@ create_fn_spec (gfc_symbol *sym, tree fntype)
     {
       gfc_symbol *result = sym->result ? sym->result : sym;
 
-      if (result->attr.pointer || sym->attr.proc_pointer)
+      if (result->attr.pointer || result->attr.proc_pointer)
 	spec[spec_len++] = '.';
       else
 	spec[spec_len++] = 'w';
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index ff0b243..275d436 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -1076,21 +1076,74 @@ gfc_deallocate_scalar_with_status (tree pointer, tree status, bool can_fail,
   gfc_start_block (&non_null);
   
   /* Free allocatable components.  */
-  if (ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp)
+{
+  gfc_expr *final_expr = NULL;
+  gfc_code *code;
+
+/* FIXME:  !expr && ts.type == BT_CLASS shouldn't happen.
+   Cf. trans-array.c's structure_alloc_comps for a case where it does occur.  */
+  if (expr && ts.type == BT_CLASS)
     {
-      tmp = build_fold_indirect_ref_loc (input_location, pointer);
-      tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0);
+      final_expr = gfc_copy_expr (expr);
+      gfc_add_vptr_component (final_expr);
+      gfc_add_component_ref (final_expr, "_final");
+    }
+  else if (expr && ts.type == BT_DERIVED)
+    {
+      gfc_symbol *vtab = gfc_find_derived_vtab (ts.u.derived);
+      if (vtab)
+	{
+	  gfc_component *final;
+	  final = vtab->ts.u.derived->components->next->next->next->next->next;
+	  gcc_assert (strcmp (final->name, "_final") == 0);
+
+	  if (final->initializer && final->initializer->expr_type != EXPR_NULL)
+	    final_expr = final->initializer;
+	}
+    }
+
+  if (final_expr)
+    {
+      gcc_assert (expr);
+      gcc_assert (final_expr->expr_type == EXPR_VARIABLE);
+
+      code = gfc_get_code ();
+      code->resolved_sym = gfc_get_proc_ptr_comp (final_expr)->ts.interface;
+      code->ext.actual = gfc_get_actual_arglist ();
+      code->ext.actual->expr = gfc_copy_expr (expr);
+      code->ext.actual->next = gfc_get_actual_arglist ();
+      code->ext.actual->next->expr = gfc_get_logical_expr (4, NULL, false);
+      code->expr1 = gfc_copy_expr (final_expr);
+      code->op = EXEC_CALL;
+      tmp = gfc_trans_call (code, true, NULL, NULL, false);
+
+      if (ts.type == BT_CLASS)
+	{
+	  tree cond;
+	  gfc_se se;
+
+	  gfc_init_se (&se, NULL);
+	  se.want_pointer = 1;
+	  gfc_conv_expr (&se, final_expr);
+	  cond = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+				  se.expr,
+				  build_int_cst (TREE_TYPE (se.expr), 0));
+
+	  tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
+				 cond, tmp, build_empty_stmt (input_location));
+	}
+
+      gfc_free_statements (code);
       gfc_add_expr_to_block (&non_null, tmp);
     }
-  else if (ts.type == BT_CLASS
-	   && ts.u.derived->components->ts.u.derived->attr.alloc_comp)
+
+  if (!final_expr && ts.type == BT_DERIVED && ts.u.derived->attr.alloc_comp)
     {
       tmp = build_fold_indirect_ref_loc (input_location, pointer);
-      tmp = gfc_deallocate_alloc_comp (ts.u.derived->components->ts.u.derived,
-				       tmp, 0);
+      tmp = gfc_deallocate_alloc_comp (ts.u.derived, tmp, 0);
       gfc_add_expr_to_block (&non_null, tmp);
     }
-  
+}  
   tmp = build_call_expr_loc (input_location,
 			     builtin_decl_explicit (BUILT_IN_FREE), 1,
 			     fold_convert (pvoid_type_node, pointer));
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 9818ceb..654846a 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -348,6 +348,7 @@ tree gfc_vtable_size_get (tree);
 tree gfc_vtable_extends_get (tree);
 tree gfc_vtable_def_init_get (tree);
 tree gfc_vtable_copy_get (tree);
+tree gfc_vtable_final_get (tree);
 tree gfc_get_vptr_from_expr (tree);
 tree gfc_get_class_array_ref (tree, tree);
 tree gfc_copy_class_to_class (tree, tree, tree);
diff --git a/gcc/testsuite/gfortran.dg/finalize_4.f03 b/gcc/testsuite/gfortran.dg/finalize_4.f03
index 11e094f..512dd1e 100644
--- a/gcc/testsuite/gfortran.dg/finalize_4.f03
+++ b/gcc/testsuite/gfortran.dg/finalize_4.f03
@@ -1,4 +1,4 @@
-! { dg-do compile }
+! { dg-do run }
 
 ! Parsing of finalizer procedure definitions.
 ! Check parsing of valid finalizer definitions.
@@ -48,6 +48,3 @@ PROGRAM finalizer
   DEALLOCATE(mat)
 
 END PROGRAM finalizer
-
-! TODO: Remove this once finalization is implemented.
-! { dg-excess-errors "not yet implemented" }
diff --git a/gcc/testsuite/gfortran.dg/finalize_5.f03 b/gcc/testsuite/gfortran.dg/finalize_5.f03
index b9ec376..fb81531 100644
--- a/gcc/testsuite/gfortran.dg/finalize_5.f03
+++ b/gcc/testsuite/gfortran.dg/finalize_5.f03
@@ -107,6 +107,3 @@ PROGRAM finalizer
   IMPLICIT NONE
   ! Nothing here, errors above
 END PROGRAM finalizer
-
-! TODO: Remove this once finalization is implemented.
-! { dg-excess-errors "not yet implemented" }
diff --git a/gcc/testsuite/gfortran.dg/finalize_6.f90 b/gcc/testsuite/gfortran.dg/finalize_6.f90
index 82d662f..d888a4b 100644
--- a/gcc/testsuite/gfortran.dg/finalize_6.f90
+++ b/gcc/testsuite/gfortran.dg/finalize_6.f90
@@ -28,6 +28,3 @@ PROGRAM finalizer
   IMPLICIT NONE
   ! Do nothing
 END PROGRAM finalizer
-
-! TODO: Remove this once finalization is implemented.
-! { dg-excess-errors "not yet implemented" }
diff --git a/gcc/testsuite/gfortran.dg/finalize_7.f03 b/gcc/testsuite/gfortran.dg/finalize_7.f03
index 6ca4f55..5807ed5 100644
--- a/gcc/testsuite/gfortran.dg/finalize_7.f03
+++ b/gcc/testsuite/gfortran.dg/finalize_7.f03
@@ -52,6 +52,3 @@ PROGRAM finalizer
   IMPLICIT NONE
   ! Nothing here
 END PROGRAM finalizer
-
-! TODO: Remove this once finalization is implemented.
-! { dg-excess-errors "not yet implemented" }