From 81fb8a483c2c59c5c301f1c0e48deb849ed2aeb0 Mon Sep 17 00:00:00 2001 From: Mikael Morin Date: Thu, 29 Jul 2010 11:22:40 +0000 Subject: [PATCH] re PR fortran/42051 ([OOP] ICE on array-valued function with CLASS formal argument) 2010-07-29 Mikael Morin PR fortran/42051 PR fortran/44064 * class.c (gfc_find_derived_vtab): Accept or discard newly created symbols before returning. 2010-07-29 Mikael Morin PR fortran/42051 PR fortran/44064 * gfortran.dg/pr42051.f03: New testcase. From-SVN: r162674 --- gcc/fortran/ChangeLog | 7 ++++++ gcc/fortran/class.c | 22 +++++++++++----- gcc/testsuite/ChangeLog | 6 +++++ gcc/testsuite/gfortran.dg/pr42051.f03 | 36 +++++++++++++++++++++++++++ 4 files changed, 65 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/pr42051.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2942701b527..02263afddef 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2010-07-29 Mikael Morin + + PR fortran/42051 + PR fortran/44064 + * class.c (gfc_find_derived_vtab): Accept or discard newly created + symbols before returning. + 2010-07-29 Joseph Myers * lang.opt (cpp): Remove Joined and Separate markers. diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index b5e17f4e2f6..b3a558b5f9a 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -321,7 +321,7 @@ gfc_symbol * gfc_find_derived_vtab (gfc_symbol *derived) { gfc_namespace *ns; - gfc_symbol *vtab = NULL, *vtype = NULL; + gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL; char name[2 * GFC_MAX_SYMBOL_LEN + 8]; ns = gfc_current_ns; @@ -356,13 +356,13 @@ gfc_find_derived_vtab (gfc_symbol *derived) gfc_get_symbol (name, ns, &vtype); if (gfc_add_flavor (&vtype->attr, FL_DERIVED, NULL, &gfc_current_locus) == FAILURE) - return NULL; + goto cleanup; vtype->refs++; gfc_set_sym_referenced (vtype); /* Add component '$hash'. */ if (gfc_add_component (vtype, "$hash", &c) == FAILURE) - return NULL; + goto cleanup; c->ts.type = BT_INTEGER; c->ts.kind = 4; c->attr.access = ACCESS_PRIVATE; @@ -371,7 +371,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) /* Add component '$size'. */ if (gfc_add_component (vtype, "$size", &c) == FAILURE) - return NULL; + goto cleanup; c->ts.type = BT_INTEGER; c->ts.kind = 4; c->attr.access = ACCESS_PRIVATE; @@ -384,7 +384,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) /* Add component $extends. */ if (gfc_add_component (vtype, "$extends", &c) == FAILURE) - return NULL; + goto cleanup; c->attr.pointer = 1; c->attr.access = ACCESS_PRIVATE; parent = gfc_get_derived_super_type (derived); @@ -414,7 +414,17 @@ gfc_find_derived_vtab (gfc_symbol *derived) } } - return vtab; + found_sym = vtab; + +cleanup: + /* It is unexpected to have some symbols added at resolution or code + generation time. We commit the changes in order to keep a clean state. */ + if (found_sym) + gfc_commit_symbols (); + else + gfc_undo_symbols (); + + return found_sym; } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a41b8202631..fdb52bd338c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-07-29 Mikael Morin + + PR fortran/42051 + PR fortran/44064 + * gfortran.dg/pr42051.f03: New testcase. + 2010-07-29 Richard Guenther PR middle-end/45034 diff --git a/gcc/testsuite/gfortran.dg/pr42051.f03 b/gcc/testsuite/gfortran.dg/pr42051.f03 new file mode 100644 index 00000000000..308c1e7229f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr42051.f03 @@ -0,0 +1,36 @@ +! { dg-do compile } +! { dg-options "-fno-whole-file" } +! +! PR fortran/42051 +! PR fortran/44064 +! Access to freed symbols +! +! Testcase provided by Damian Rouson , +! reduced by Janus Weil . + +module grid_module + implicit none + type grid + end type + type field + type(grid) :: mesh + end type +contains + real function return_x(this) + class(grid) :: this + end function +end module + +module field_module + use grid_module, only: field,return_x + implicit none +contains + subroutine output(this) + class(field) :: this + print *,return_x(this%mesh) + end subroutine +end module + +end + +! { dg-final { cleanup-modules "grid_module field_module" } }