re PR fortran/64230 (Invalid memory reference in a compiler-generated finalizer for...

2015-01-26  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/64230
	* class.c (finalize_component): New argument 'sub_ns'. Insert code to
	check if 'expr' is associated.
	(generate_finalization_wrapper): Rename 'ptr' symbols to 'ptr1' and
	'ptr2'. Pass 'sub_ns' to finalize_component.

2015-01-26  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/64230
	* gfortran.dg/class_allocate_18.f90: New.

From-SVN: r220125

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 15c3ba01f9f552bedcabd6020dfb5bcbc52d6709..478c59538a2e538fa3ddc4c5be9e893188c58b10 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2015-01-26  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/64230
+       * class.c (finalize_component): New argument 'sub_ns'. Insert code to
+       check if 'expr' is associated.
+       (generate_finalization_wrapper): Rename 'ptr' symbols to 'ptr1' and
+       'ptr2'. Pass 'sub_ns' to finalize_component.
+
 2015-01-25  Mikael Morin  <mikael@gcc.gnu.org>
 
        PR fortran/62044

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index 55e7ef4a56bab3a9c6d69c3be67763db69f36277..786876c85d99bbf1bd889894d6261b84365b0485 100644 (file)
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -881,7 +881,8 @@ comp_is_finalizable (gfc_component *comp)
 
 static void
 finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
-                   gfc_symbol *stat, gfc_symbol *fini_coarray, gfc_code **code)
+                   gfc_symbol *stat, gfc_symbol *fini_coarray, gfc_code **code,
+                   gfc_namespace *sub_ns)
 {
   gfc_expr *e;
   gfc_ref *ref;
@@ -950,15 +951,32 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
       dealloc->ext.alloc.list->expr = e;
       dealloc->expr1 = gfc_lval_expr_from_sym (stat);
 
+      gfc_code *cond = gfc_get_code (EXEC_IF);
+      cond->block = gfc_get_code (EXEC_IF);
+      cond->block->expr1 = gfc_get_expr ();
+      cond->block->expr1->expr_type = EXPR_FUNCTION;
+      gfc_get_sym_tree ("associated", sub_ns, &cond->block->expr1->symtree, false);
+      cond->block->expr1->symtree->n.sym->attr.flavor = FL_PROCEDURE;
+      cond->block->expr1->symtree->n.sym->attr.intrinsic = 1;
+      cond->block->expr1->symtree->n.sym->result = cond->block->expr1->symtree->n.sym;
+      gfc_commit_symbol (cond->block->expr1->symtree->n.sym);
+      cond->block->expr1->ts.type = BT_LOGICAL;
+      cond->block->expr1->ts.kind = gfc_default_logical_kind;
+      cond->block->expr1->value.function.isym = gfc_intrinsic_function_by_id (GFC_ISYM_ASSOCIATED);
+      cond->block->expr1->value.function.actual = gfc_get_actual_arglist ();
+      cond->block->expr1->value.function.actual->expr = gfc_copy_expr (expr);
+      cond->block->expr1->value.function.actual->next = gfc_get_actual_arglist ();
+      cond->block->next = dealloc;
+
       if (block)
-       block->next = dealloc;
+       block->next = cond;
       else if (*code)
        {
-         (*code)->next = dealloc;
+         (*code)->next = cond;
          (*code) = (*code)->next;
        }
       else
-       (*code) = dealloc;
+       (*code) = cond;
     }
   else if (comp->ts.type == BT_DERIVED
            && comp->ts.u.derived->f2k_derived
@@ -994,7 +1012,8 @@ finalize_component (gfc_expr *expr, gfc_symbol *derived, gfc_component *comp,
       gfc_component *c;
 
       for (c = comp->ts.u.derived->components; c; c = c->next)
-       finalize_component (e, comp->ts.u.derived, c, stat, fini_coarray, code);
+       finalize_component (e, comp->ts.u.derived, c, stat, fini_coarray, code,
+                           sub_ns);
       gfc_free_expr (e);
     }
 }
@@ -1927,7 +1946,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
     {
       gfc_finalizer *fini, *fini_elem = NULL;
 
-      gfc_get_symbol ("ptr", sub_ns, &ptr);
+      gfc_get_symbol ("ptr1", sub_ns, &ptr);
       ptr->ts.type = BT_DERIVED;
       ptr->ts.u.derived = derived;
       ptr->attr.flavor = FL_VARIABLE;
@@ -2051,7 +2070,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
 
       if (!ptr)
        {
-         gfc_get_symbol ("ptr", sub_ns, &ptr);
+         gfc_get_symbol ("ptr2", sub_ns, &ptr);
          ptr->ts.type = BT_DERIVED;
          ptr->ts.u.derived = derived;
          ptr->attr.flavor = FL_VARIABLE;
@@ -2100,7 +2119,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns,
            continue;
 
          finalize_component (gfc_lval_expr_from_sym (ptr), derived, comp,
-                             stat, fini_coarray, &block);
+                             stat, fini_coarray, &block, sub_ns);
          if (!last_code->block->next)
            last_code->block->next = block;
        }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 07f6f66f32faf790acdcaae9a7ea4bee263f6666..128425f09e261f7085ae7353c3a68de4cce3a94c 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2015-01-26  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/64230
+       * gfortran.dg/class_allocate_18.f90: New.
+
 2015-01-26  Christophe Lyon  <christophe.lyon@linaro.org>
 
        * gcc.target/aarch64/advsimd-intrinsics/vpaddl.c: New file.

diff --git a/gcc/testsuite/gfortran.dg/class_allocate_18.f90 b/gcc/testsuite/gfortran.dg/class_allocate_18.f90
new file mode 100644 (file)
index 0000000..0dd0c68
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_allocate_18.f90
@@ -0,0 +1,22 @@
+! { dg-do run }
+! { dg-options "-fsanitize=undefined" }
+!
+! PR 64230: [4.9/5 Regression] Invalid memory reference in a compiler-generated finalizer for allocatable component
+!
+! Contributed by Mat Cross <mathewc@nag.co.uk>
+
+Program main
+  Implicit None
+  Type :: t1
+  End Type
+  Type, Extends (t1) :: t2
+    Integer, Allocatable :: i
+  End Type
+  Type, Extends (t2) :: t3
+    Integer, Allocatable :: j
+  End Type
+  Class (t1), Allocatable :: t
+  Allocate (t3 :: t)
+  print *,"allocated!"
+  Deallocate (t)
+End