From 807b50a72bcaaa2ded0af983a055465621204b13 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Mon, 26 Jan 2015 16:56:03 +0100 Subject: [PATCH] re PR fortran/64230 (Invalid memory reference in a compiler-generated finalizer for allocatable component) 2015-01-26 Janus Weil 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 PR fortran/64230 * gfortran.dg/class_allocate_18.f90: New. From-SVN: r220125 --- gcc/fortran/ChangeLog | 8 +++++ gcc/fortran/class.c | 35 ++++++++++++++----- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/class_allocate_18.f90 | 22 ++++++++++++ 4 files changed, 62 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_allocate_18.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 15c3ba01f9f..478c59538a2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2015-01-26 Janus Weil + + 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 PR fortran/62044 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index 55e7ef4a56b..786876c85d9 100644 --- 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 07f6f66f32f..128425f09e2 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2015-01-26 Janus Weil + + PR fortran/64230 + * gfortran.dg/class_allocate_18.f90: New. + 2015-01-26 Christophe Lyon * 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 index 00000000000..0dd0c68367e --- /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 + +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 -- 2.30.2