re PR fortran/44912 ([OOP] Segmentation fault on TBP)

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

	PR fortran/44912
	* class.c (gfc_build_class_symbol): Make '$vptr' component private.
	(gfc_find_derived_vtab): Make vtabs and vtypes public.
	* module.c (read_module): When reading module files, always import
	vtab and vtype symbols.

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

	PR fortran/44912
	* gfortran.dg/typebound_call_17.f03: New.

From-SVN: r162804

gcc/fortran/ChangeLog

+2010-08-01  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44912
+	* class.c (gfc_build_class_symbol): Make '$vptr' component private.
+	(gfc_find_derived_vtab): Make vtabs and vtypes public.
+	* module.c (read_module): When reading module files, always import
+	vtab and vtype symbols.
+
 2010-07-31  Mikael Morin  <mikael@gcc.gnu.org>
 
 	PR fortran/42051

gcc/fortran/class.c

@@ -178,6 +178,7 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
 	  gcc_assert (vtab);
 	  c->ts.u.derived = vtab->ts.u.derived;
 	}
+      c->attr.access = ACCESS_PRIVATE;
       c->attr.pointer = 1;
     }
 
@@ -343,6 +344,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 	  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);
@@ -357,6 +359,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
 	      if (gfc_add_flavor (&vtype->attr, FL_DERIVED,
 				  NULL, &gfc_current_locus) == FAILURE)
 		goto cleanup;
+	      vtype->attr.access = ACCESS_PUBLIC;
 	      vtype->refs++;
 	      gfc_set_sym_referenced (vtype);
 

gcc/fortran/module.c

@@ -4370,6 +4370,11 @@ read_module (void)
 	  if (p == NULL && strcmp (name, module_name) == 0)
 	    p = name;
 
+	  /* Exception: Always import vtabs & vtypes.  */
+	  if (p == NULL && (strcmp (xstrndup (name,5), "vtab$") == 0
+			    || strcmp (xstrndup (name,6), "vtype$") == 0))
+	    p = name;
+
 	  /* Skip symtree nodes not in an ONLY clause, unless there
 	     is an existing symtree loaded from another USE statement.  */
 	  if (p == NULL)

gcc/testsuite/ChangeLog

+2010-08-01  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/44912
+	* gfortran.dg/typebound_call_17.f03: New.
+
 2010-07-30  Janus Weil  <janus@gcc.gnu.org>
 
 	PR fortran/44929

gcc/testsuite/gfortran.dg/typebound_call_17.f03

+! { dg-do run }
+!
+! PR 44912: [OOP] Segmentation fault on TBP
+!
+! Contributed by Satish.BD <bdsatish@gmail.com>
+
+module polynomial
+implicit none
+
+private
+
+type, public :: polynom
+   complex, allocatable, dimension(:) :: a
+   integer :: n
+ contains
+   procedure :: init_from_coeff
+   procedure :: get_degree
+   procedure :: add_poly
+end type polynom
+
+contains
+  subroutine init_from_coeff(self, coeff)
+    class(polynom), intent(inout) :: self
+    complex, dimension(:), intent(in) :: coeff
+    self%n = size(coeff) - 1
+    allocate(self%a(self%n + 1))
+    self%a = coeff
+    print *,"ifc:",self%a
+  end subroutine init_from_coeff
+
+  function get_degree(self)   result(n)
+    class(polynom), intent(in) :: self
+    integer :: n
+    print *,"gd"
+    n = self%n
+  end function get_degree
+
+  subroutine add_poly(self)
+    class(polynom), intent(in) :: self
+    integer :: s
+    print *,"ap"
+    s = self%get_degree()         !!!! fails here
+  end subroutine
+
+end module polynomial
+
+program test_poly
+   use polynomial, only: polynom
+
+   type(polynom) :: p1
+
+   call p1%init_from_coeff([(1,0),(2,0),(3,0)])
+   call p1%add_poly()
+
+end program test_poly
+
+! { dg-final { cleanup-modules "polynomial" } }