[Patch, Fortran] PR 51809 Fix ICE with __vtab

[Tobias Burnus <burnus at net-b dot de>]

Dear all,

current gfortran uses FL_PARAMETER for _vtab and _init_def; 
unfortunately, that will fail sometimes to properly read the symbols; in 
the PR _vtab->_extension's symbol is not properly read, depending on the 
USE statement order.

I tried to debug it, but I was not very successful. In principle, the 
fixup mechanism should work. On the other hand, the internally generated 
code is not valid: _vtab is a variable of a derived type with pointer 
components (so far so good).

However, Fortran does not allow one to mark such a variable as 
PARAMETER. The main reason is that one could use TRANSFER on the 
parameter - and TRANSFER is back to a pointer somewhere else. That's 
only possible if the value is known at compilation time. However, 
pointer addresses are only known at run time. That does not rule out 
that one uses a PARAMETER internally, but it reduces the incentive to 
debug the issue as it can only affect __vtab/__def_init.

Thus, I decided to backout the patch Rev. 181199 (cf. PR, comment 1) - 
and implement a simple TREE_READONLY in trans-decl.c.

Build and regtested on x86-64-linux.
OK for the 4.7 trunk?

Tobias
2012-01-16  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51809
	* class.c (gfc_find_derived_vtab): Mark __vtab and
	__def_init as FL_VARIABLE not as FL_PARAMETER.
	* expr.c (gfc_simplify_expr): Remove special
	handling of __vtab.
	* resolve.c (resolve_values): Ditto.
	* trans-decl.c (gfc_get_symbol_decl): Mark __vtab
	and __def_init as TREE_READONLY.

2012-01-16  Tobias Burnus  <burnus@net-b.de>

	PR fortran/51809
	* gfortran.dg/use_20.f90: New

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index a17fc0a..5e5de14 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -588,7 +588,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 	{
 	  gfc_get_symbol (name, ns, &vtab);
 	  vtab->ts.type = BT_DERIVED;
-	  if (gfc_add_flavor (&vtab->attr, FL_PARAMETER, NULL,
+	  if (gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL,
 	                      &gfc_current_locus) == FAILURE)
 	    goto cleanup;
 	  vtab->attr.target = 1;
@@ -682,7 +682,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 		  def_init->attr.target = 1;
 		  def_init->attr.save = SAVE_IMPLICIT;
 		  def_init->attr.access = ACCESS_PUBLIC;
-		  def_init->attr.flavor = FL_PARAMETER;
+		  def_init->attr.flavor = FL_VARIABLE;
 		  gfc_set_sym_referenced (def_init);
 		  def_init->ts.type = BT_DERIVED;
 		  def_init->ts.u.derived = derived;
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index a6baa68..8f04c73 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1883,8 +1883,7 @@ gfc_simplify_expr (gfc_expr *p, int type)
 	 initialization expression, or we want a subsection.  */
       if (p->symtree->n.sym->attr.flavor == FL_PARAMETER
 	  && (gfc_init_expr_flag || p->ref
-	      || p->symtree->n.sym->value->expr_type != EXPR_ARRAY)
-	  && !p->symtree->n.sym->attr.vtab)
+	      || p->symtree->n.sym->value->expr_type != EXPR_ARRAY))
 	{
 	  if (simplify_parameter_variable (p, type) == FAILURE)
 	    return FAILURE;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 352d22d..c169b9e 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9637,7 +9637,7 @@ resolve_values (gfc_symbol *sym)
 {
   gfc_try t;
 
-  if (sym->value == NULL || sym->attr.use_assoc)
+  if (sym->value == NULL)
     return;
 
   if (sym->value->expr_type == EXPR_STRUCTURE)
@@ -12195,7 +12195,7 @@ resolve_fl_parameter (gfc_symbol *sym)
   /* Make sure the types of derived parameters are consistent.  This
      type checking is deferred until resolution because the type may
      refer to a derived type from the host.  */
-  if (sym->ts.type == BT_DERIVED && sym->value
+  if (sym->ts.type == BT_DERIVED
       && !gfc_compare_types (&sym->ts, &sym->value->ts))
     {
       gfc_error ("Incompatible derived type in PARAMETER at %L",
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 0761ebb..e8e54c7 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1485,7 +1485,10 @@ gfc_get_symbol_decl (gfc_symbol * sym)
 
   if (sym->attr.vtab
       || (sym->name[0] == '_' && strncmp ("__def_init", sym->name, 10) == 0))
-    GFC_DECL_PUSH_TOPLEVEL (decl) = 1;
+    {
+      TREE_READONLY (decl) = 1;
+      GFC_DECL_PUSH_TOPLEVEL (decl) = 1;
+    }
 
   return decl;
 }
--- /dev/null	2012-01-16 08:28:57.351763035 +0100
+++ gcc/gcc/testsuite/gfortran.dg/use_20.f90	2012-01-16 18:41:44.000000000 +0100
@@ -0,0 +1,49 @@
+! { dg-do compile }
+!
+! PR fortran/51809
+!
+! Contributed by Kacper Kowalik
+!
+module foo
+   implicit none
+
+   type foo_t
+   contains
+      procedure :: func_foo
+   end type foo_t
+
+contains
+
+   subroutine func_foo(this)
+      implicit none
+      class(foo_t), intent(in) :: this
+   end subroutine func_foo
+
+end module foo
+
+module bar
+   use foo,   only: foo_t
+
+   implicit none
+
+   type, extends(foo_t) :: bar_t
+   contains
+      procedure :: func_bar
+   end type bar_t
+
+contains
+
+   subroutine func_bar(this)
+      use foo,    only: foo_t     ! <--- removing this line also fixes ICE
+      implicit none
+      class(bar_t), intent(in) :: this
+   end subroutine func_bar
+
+end module bar
+
+module merry_ICE
+   use foo,  only: foo_t   ! <------ change order to prevent ICE
+   use bar,  only: bar_t   ! <------ change order to prevent ICE
+end module merry_ICE
+
+! { dg-final { cleanup-modules "foo bar merry_ice" } }