Commit 81fb8a48 by Mikael Morin

re PR fortran/42051 ([OOP] ICE on array-valued function with CLASS formal argument)

2010-07-29  Mikael Morin  <mikael@gcc.gnu.org>

	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  <mikael@gcc.gnu.org>

	PR fortran/42051
	PR fortran/44064
	* gfortran.dg/pr42051.f03: New testcase.

From-SVN: r162674
parent 6befd6b0
2010-07-29 Mikael Morin <mikael@gcc.gnu.org>
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 <joseph@codesourcery.com> 2010-07-29 Joseph Myers <joseph@codesourcery.com>
* lang.opt (cpp): Remove Joined and Separate markers. * lang.opt (cpp): Remove Joined and Separate markers.
......
...@@ -321,7 +321,7 @@ gfc_symbol * ...@@ -321,7 +321,7 @@ gfc_symbol *
gfc_find_derived_vtab (gfc_symbol *derived) gfc_find_derived_vtab (gfc_symbol *derived)
{ {
gfc_namespace *ns; 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]; char name[2 * GFC_MAX_SYMBOL_LEN + 8];
ns = gfc_current_ns; ns = gfc_current_ns;
...@@ -356,13 +356,13 @@ gfc_find_derived_vtab (gfc_symbol *derived) ...@@ -356,13 +356,13 @@ gfc_find_derived_vtab (gfc_symbol *derived)
gfc_get_symbol (name, ns, &vtype); gfc_get_symbol (name, ns, &vtype);
if (gfc_add_flavor (&vtype->attr, FL_DERIVED, if (gfc_add_flavor (&vtype->attr, FL_DERIVED,
NULL, &gfc_current_locus) == FAILURE) NULL, &gfc_current_locus) == FAILURE)
return NULL; goto cleanup;
vtype->refs++; vtype->refs++;
gfc_set_sym_referenced (vtype); gfc_set_sym_referenced (vtype);
/* Add component '$hash'. */ /* Add component '$hash'. */
if (gfc_add_component (vtype, "$hash", &c) == FAILURE) if (gfc_add_component (vtype, "$hash", &c) == FAILURE)
return NULL; goto cleanup;
c->ts.type = BT_INTEGER; c->ts.type = BT_INTEGER;
c->ts.kind = 4; c->ts.kind = 4;
c->attr.access = ACCESS_PRIVATE; c->attr.access = ACCESS_PRIVATE;
...@@ -371,7 +371,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) ...@@ -371,7 +371,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
/* Add component '$size'. */ /* Add component '$size'. */
if (gfc_add_component (vtype, "$size", &c) == FAILURE) if (gfc_add_component (vtype, "$size", &c) == FAILURE)
return NULL; goto cleanup;
c->ts.type = BT_INTEGER; c->ts.type = BT_INTEGER;
c->ts.kind = 4; c->ts.kind = 4;
c->attr.access = ACCESS_PRIVATE; c->attr.access = ACCESS_PRIVATE;
...@@ -384,7 +384,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) ...@@ -384,7 +384,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
/* Add component $extends. */ /* Add component $extends. */
if (gfc_add_component (vtype, "$extends", &c) == FAILURE) if (gfc_add_component (vtype, "$extends", &c) == FAILURE)
return NULL; goto cleanup;
c->attr.pointer = 1; c->attr.pointer = 1;
c->attr.access = ACCESS_PRIVATE; c->attr.access = ACCESS_PRIVATE;
parent = gfc_get_derived_super_type (derived); parent = gfc_get_derived_super_type (derived);
...@@ -414,7 +414,17 @@ gfc_find_derived_vtab (gfc_symbol *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;
} }
......
2010-07-29 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/42051
PR fortran/44064
* gfortran.dg/pr42051.f03: New testcase.
2010-07-29 Richard Guenther <rguenther@suse.de> 2010-07-29 Richard Guenther <rguenther@suse.de>
PR middle-end/45034 PR middle-end/45034
......
! { dg-do compile }
! { dg-options "-fno-whole-file" }
!
! PR fortran/42051
! PR fortran/44064
! Access to freed symbols
!
! Testcase provided by Damian Rouson <damian@rouson.net>,
! reduced by Janus Weil <janus@gcc.gnu.org>.
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" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment