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.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1bc2a1f..fa41c8a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+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
 2010-07-31  Mikael Morin  <mikael@gcc.gnu.org>
 
        PR fortran/42051

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index b3a558b..9393b56 100644 (file)
--- a/gcc/fortran/class.c
+++ b/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;
        }
          gcc_assert (vtab);
          c->ts.u.derived = vtab->ts.u.derived;
        }

+      c->attr.access = ACCESS_PRIVATE;

       c->attr.pointer = 1;
     }
 
       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.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);
          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;
              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);
 
              vtype->refs++;
              gfc_set_sym_referenced (vtype);
 

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 426a17c..d68e868 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -4370,6 +4370,11 @@ read_module (void)
          if (p == NULL && strcmp (name, module_name) == 0)
            p = name;
 
          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)
          /* Skip symtree nodes not in an ONLY clause, unless there
             is an existing symtree loaded from another USE statement.  */
          if (p == NULL)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0a181e8..5c211c0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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
 2010-07-30  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/44929

diff --git a/gcc/testsuite/gfortran.dg/typebound_call_17.f03 b/gcc/testsuite/gfortran.dg/typebound_call_17.f03
new file mode 100644 (file)
index 0000000..5bd0547
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_call_17.f03
@@ -0,0 +1,57 @@
+! { 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" } }