This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, Fortran] PRs 60495/58880: Fix issues with finalization expressions


This patch ensures that the finalization expression is generated and that use-associated finalizers are properly accessed.

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias
2014-04-04  Tobias Burnus  <burnus@net-b.de>

	PR fortran/58880
	PR fortran/60495
	* resolve.c (gfc_resolve_finalizers): Ensure that vtables
	and finalization wrappers are generated.
	* trans.c (gfc_build_final_call): Ensure that use_assoc
	is set for the finalization wrapper when applicable.

2014-04-04  Tobias Burnus  <burnus@net-b.de>

	PR fortran/58880
	PR fortran/60495
	* gfortran.dg/finalize_25.f90: New.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 6e23e57..38755fe 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -11200,15 +11200,36 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
    the requirements of the standard for procedures used as finalizers.  */
 
 static bool
-gfc_resolve_finalizers (gfc_symbol* derived)
+gfc_resolve_finalizers (gfc_symbol* derived, bool *finalizable)
 {
   gfc_finalizer* list;
   gfc_finalizer** prev_link; /* For removing wrong entries from the list.  */
   bool result = true;
   bool seen_scalar = false;
+  gfc_symbol *vtab;
+  gfc_component *c;
 
+  /* Return early when not finalizable. Additionally, ensure that derived-type
+     components have a their finalizables resolved.  */
   if (!derived->f2k_derived || !derived->f2k_derived->finalizers)
-    return true;
+    {
+      bool has_final = false;
+      for (c = derived->components; c; c = c->next)
+	if (c->ts.type == BT_DERIVED
+	    && !c->attr.pointer && !c->attr.proc_pointer && !c->attr.allocatable)
+	  {
+	    bool has_final2 = false;
+	    if (!gfc_resolve_finalizers (c->ts.u.derived, &has_final))
+	      return false;  /* Error.  */
+	    has_final = has_final || has_final2;
+	  }
+      if (!has_final)
+	{
+	  if (finalizable)
+	    *finalizable = false;
+	  return true;
+	}
+    }
 
   /* Walk over the list of finalizer-procedures, check them, and if any one
      does not fit in with the standard's definition, print an error and remove
@@ -11330,12 +11351,15 @@ gfc_resolve_finalizers (gfc_symbol* derived)
 	/* Remove wrong nodes immediately from the list so we don't risk any
 	   troubles in the future when they might fail later expectations.  */
 error:
-	result = false;
 	i = list;
 	*prev_link = list->next;
 	gfc_free_finalizer (i);
+	result = false;
     }
 
+  if (result == false)
+    return false;
+
   /* Warn if we haven't seen a scalar finalizer procedure (but we know there
      were nodes in the list, must have been for arrays.  It is surely a good
      idea to have a scalar version there if there's something to finalize.  */
@@ -11344,8 +11368,14 @@ error:
 		 " defined at %L, suggest also scalar one",
 		 derived->name, &derived->declared_at);
 
-  gfc_find_derived_vtab (derived);
-  return result;
+  vtab = gfc_find_derived_vtab (derived);
+  c = vtab->ts.u.derived->components->next->next->next->next->next;
+  gfc_set_sym_referenced (c->initializer->symtree->n.sym);
+
+  if (finalizable)
+    *finalizable = true;
+
+  return true;
 }
 
 
@@ -12513,7 +12543,7 @@ resolve_fl_derived (gfc_symbol *sym)
     return false;
 
   /* Resolve the finalizer procedures.  */
-  if (!gfc_resolve_finalizers (sym))
+  if (!gfc_resolve_finalizers (sym, NULL))
     return false;
 
   if (sym->attr.is_class && sym->ts.u.derived == NULL)
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 5961c26..9ea859e 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -869,6 +869,9 @@ gfc_build_final_call (gfc_typespec ts, gfc_expr *final_wrapper, gfc_expr *var,
   gcc_assert (final_wrapper->expr_type == EXPR_VARIABLE);
   gcc_assert (var);
 
+  if (final_wrapper->symtree->n.sym->module)
+    final_wrapper->symtree->n.sym->attr.use_assoc = 1;
+
   gfc_start_block (&block);
   gfc_init_se (&se, NULL);
   gfc_conv_expr (&se, final_wrapper);
diff --git a/gcc/testsuite/gfortran.dg/finalize_25.f90 b/gcc/testsuite/gfortran.dg/finalize_25.f90
new file mode 100644
index 0000000..73dc568
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/finalize_25.f90
@@ -0,0 +1,55 @@
+! { dg-do run }
+!
+! PR fortran/58880
+! PR fortran/60495
+!
+! Contributed by Andrew Benson and Janus Weil
+!
+
+module gn
+  implicit none
+  type sl
+     integer, allocatable, dimension(:) :: lv
+   contains
+     final :: sld
+  end type
+  type :: nde
+     type(sl) :: r
+  end type nde
+
+  integer :: cnt = 0
+
+contains
+
+  subroutine sld(s)
+    type(sl) :: s
+    cnt = cnt + 1
+    ! print *,'Finalize sl'
+  end subroutine
+  subroutine ndm(s)
+    type(nde), intent(inout) :: s
+    type(nde)                :: i    
+    i=s
+  end subroutine ndm
+end module
+
+program main
+  use gn
+  type :: nde2
+     type(sl) :: r
+  end type nde2
+  type(nde) :: x
+
+  cnt = 0
+  call ndm(x)
+  if (cnt /= 2) call abort()
+
+  cnt = 0
+  call ndm2()
+  if (cnt /= 3) call abort()
+contains
+  subroutine ndm2
+    type(nde2) :: s,i
+    i=s
+  end subroutine ndm2
+end program main

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]