diff options
author | Janus Weil <janus@gcc.gnu.org> | 2015-01-26 18:53:42 +0000 |
---|---|---|
committer | Janus Weil <janus@gcc.gnu.org> | 2015-01-26 18:53:42 +0000 |
commit | be0e0e06ad9267860523785021147c3c374a427d (patch) | |
tree | 19198062e3d07819661519253b1a02dc9439f859 | |
parent | 31fc3a01cda94c10949c29fabe13fe2728516a9e (diff) |
2015-01-26 Janus Weil <janus@gcc.gnu.org>
Backport from mainline
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>
Backport from mainline
PR fortran/64230
* gfortran.dg/class_allocate_18.f90: New.
git-svn-id: https://gcc.gnu.org/svn/gcc/branches/gcc-4_9-branch@220130 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r-- | gcc/fortran/ChangeLog | 9 | ||||
-rw-r--r-- | gcc/fortran/class.c | 35 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/class_allocate_18.f90 | 22 |
4 files changed, 64 insertions, 8 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2afd58bbf04..5959553d134 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2015-01-26 Janus Weil <janus@gcc.gnu.org> + + Backport from mainline + 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-24 Thomas Koenig <tkoenig@netcologne.de> Backport from trunk diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index f28c8ad407c..aee96666ed9 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -828,7 +828,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; @@ -897,15 +898,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 @@ -941,7 +959,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); } } @@ -1874,7 +1893,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; @@ -1998,7 +2017,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; @@ -2047,7 +2066,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 4c899bd9a51..91901e834da 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2015-01-26 Janus Weil <janus@gcc.gnu.org> + + Backport from mainline + PR fortran/64230 + * gfortran.dg/class_allocate_18.f90: New. + 2015-01-26 Eric Botcazou <ebotcazou@adacore.com> PR testsuite/64712 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 <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 |