re PR fortran/42207 ([OOP] Compile-time errors on typed allocation and pointer…

re PR fortran/42207 ([OOP] Compile-time errors on typed allocation and pointer function result assignment)

2010-08-04  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42207
	PR fortran/44064
	PR fortran/44065
	* class.c (gfc_find_derived_vtab): Do not generate vtabs for class
	container types. Do not artificially increase refs. Commit symbols one
	by one.
	* interface.c (compare_parameter): Make sure vtabs are present before
	generating module variables.
	* resolve.c (resolve_allocate_expr): Ditto.


2010-08-04  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42207
	PR fortran/44064
	PR fortran/44065
	* gfortran.dg/class_25.f03: New.
	* gfortran.dg/class_26.f03: New.

From-SVN: r162879

gcc/fortran/ChangeLog

+2010-08-04  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42207
+	PR fortran/44064
+	PR fortran/44065
+	* class.c (gfc_find_derived_vtab): Do not generate vtabs for class
+	container types. Do not artificially increase refs. Commit symbols one
+	by one.
+	* interface.c (compare_parameter): Make sure vtabs are present before
+	generating module variables.
+	* resolve.c (resolve_allocate_expr): Ditto.
+
 2010-08-04  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/45183

gcc/fortran/class.c

@@ -322,13 +322,16 @@ gfc_find_derived_vtab (gfc_symbol *derived)
   gfc_namespace *ns;
   gfc_symbol *vtab = NULL, *vtype = NULL, *found_sym = NULL;
   char name[2 * GFC_MAX_SYMBOL_LEN + 8];
-
-  ns = gfc_current_ns;
-
-  for (; ns; ns = ns->parent)
+  
+  /* Find the top-level namespace (MODULE or PROGRAM).  */
+  for (ns = gfc_current_ns; ns; ns = ns->parent)
     if (!ns->parent)
       break;
 
+  /* If the type is a class container, use the underlying derived type.  */
+  if (derived->attr.is_class)
+    derived = gfc_get_derived_super_type (derived);
+    
   if (ns)
     {
       sprintf (name, "vtab$%s", derived->name);
@@ -338,12 +341,13 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 	{
 	  gfc_get_symbol (name, ns, &vtab);
 	  vtab->ts.type = BT_DERIVED;
-	  vtab->attr.flavor = FL_VARIABLE;
+	  if (gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL,
+	                      &gfc_current_locus) == FAILURE)
+	    goto cleanup;
 	  vtab->attr.target = 1;
 	  vtab->attr.save = SAVE_EXPLICIT;
 	  vtab->attr.vtab = 1;
 	  vtab->attr.access = ACCESS_PUBLIC;
-	  vtab->refs++;
 	  gfc_set_sym_referenced (vtab);
 	  sprintf (name, "vtype$%s", derived->name);
 	  
@@ -358,7 +362,6 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 				  NULL, &gfc_current_locus) == FAILURE)
 		goto cleanup;
 	      vtype->attr.access = ACCESS_PUBLIC;
-	      vtype->refs++;
 	      gfc_set_sym_referenced (vtype);
 
 	      /* Add component '$hash'.  */
@@ -421,7 +424,11 @@ 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 ();
+    {
+      gfc_commit_symbol (vtab);
+      if (vtype)
+	gfc_commit_symbol (vtype);
+    }
   else
     gfc_undo_symbols ();
 

gcc/fortran/interface.c

@@ -1423,6 +1423,11 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
       && actual->ts.u.derived && actual->ts.u.derived->ts.is_iso_c)
     return 1;
 
+  if (formal->ts.type == BT_CLASS)
+    /* Make sure the vtab symbol is present when
+       the module variables are generated.  */
+    gfc_find_derived_vtab (formal->ts.u.derived);
+
   if (actual->ts.type == BT_PROCEDURE)
     {
       char err[200];

gcc/fortran/resolve.c

@@ -6569,6 +6569,18 @@ resolve_allocate_expr (gfc_expr *e, gfc_code *code)
 	}
     }
 
+  if (e->ts.type == BT_CLASS)
+    {
+      /* Make sure the vtab symbol is present when
+	 the module variables are generated.  */
+      gfc_typespec ts = e->ts;
+      if (code->expr3)
+	ts = code->expr3->ts;
+      else if (code->ext.alloc.ts.type == BT_DERIVED)
+	ts = code->ext.alloc.ts;
+      gfc_find_derived_vtab (ts.u.derived);
+    }
+
   if (pointer || (dimension == 0 && codimension == 0))
     goto success;
 

gcc/testsuite/ChangeLog

+2010-08-04  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/42207
+	PR fortran/44064
+	PR fortran/44065
+	* gfortran.dg/class_25.f03: New.
+	* gfortran.dg/class_26.f03: New.
+
 2010-08-04  Daniel Gutson  <dgutson@codesourcery.com>
 
 	* g++.dg/warn/miss-format-1.C: Update line number.

gcc/testsuite/gfortran.dg/class_25.f03

+! { dg-do run }
+!
+! PR [OOP] Compile-time errors on typed allocation and pointer function result assignment
+!
+! Contributed by Damian Rouson <damian@rouson.net>
+
+module m
+
+  implicit none
+
+  type foo 
+  end type
+
+  type ,extends(foo) :: bar
+  end type
+
+contains
+
+  function new_bar()
+    class(foo) ,pointer :: new_bar
+    allocate(bar :: new_bar) 
+  end function
+
+end module
+
+end 
+
+! { dg-final { cleanup-modules "m" } }

gcc/testsuite/gfortran.dg/class_26.f03

+! { dg-do run }
+!
+! PR 44065: [OOP] Undefined reference to vtab$...
+!
+! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
+
+module s_mat_mod
+  implicit none 
+  type :: s_sparse_mat
+  end type
+contains
+  subroutine s_set_triangle(a)
+    class(s_sparse_mat), intent(inout) :: a
+  end subroutine
+end module
+
+module s_tester
+implicit none
+contains
+  subroutine s_ussv_2
+    use s_mat_mod
+    type(s_sparse_mat) :: a
+    call s_set_triangle(a)
+  end subroutine
+end module
+
+end
+ 
+! { dg-final { cleanup-modules "s_mat_mod s_tester" } }