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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162674 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2942701..02263af 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+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>
 
        * lang.opt (cpp): Remove Joined and Separate markers.

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index b5e17f4..b3a558b 100644 (file)
--- 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 a41b820..fdb52bd 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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>
 
        PR middle-end/45034

diff --git a/gcc/testsuite/gfortran.dg/pr42051.f03 b/gcc/testsuite/gfortran.dg/pr42051.f03
new file mode 100644 (file)
index 0000000..308c1e7
--- /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 <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" } }