2010-02-09 Paul Thomas <pault@gcc.gnu.org>

        PR fortran/41869
        * module.c (fix_mio_expr): Fix for private generic procedures.

2010-02-09  Tobias Burnus  <burnus@net-b.de>

        PR fortran/41869
        * gfortran.dg/module_write_1.f90: New test.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 3c6d009..f922b4e 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2010-02-09  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/41869
+       * module.c (fix_mio_expr): Fix for private generic procedures.
+
 2010-02-09  Daniel Kraft  <d@domob.eu>
 
        PR fortran/39171

diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index c72cac1..36db863 100644 (file)
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2934,6 +2934,19 @@ fix_mio_expr (gfc_expr *e)
       fname = e->value.function.esym ? e->value.function.esym->name
                                     : e->value.function.isym->name;
       e->symtree = gfc_find_symtree (gfc_current_ns->sym_root, fname);
+
+      if (e->symtree)
+       return;
+
+      /* This is probably a reference to a private procedure from another
+        module.  To prevent a segfault, make a generic with no specific
+        instances.  If this module is used, without the required
+        specific coming from somewhere, the appropriate error message
+        is issued.  */
+      gfc_get_symbol (fname, gfc_current_ns, &sym);
+      sym->attr.flavor = FL_PROCEDURE;
+      sym->attr.generic = 1;
+      e->symtree = gfc_find_symtree (gfc_current_ns->sym_root, fname);
     }
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2261532..4dd6762 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-02-09  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/41869
+       * gfortran.dg/module_write_1.f90: New test.
+
 2010-02-09  Alexander Monakov  <amonakov@ispras.ru>
 
        * gcc.dg/pr19340.c: Adjust.

diff --git a/gcc/testsuite/gfortran.dg/module_write_1.f90 b/gcc/testsuite/gfortran.dg/module_write_1.f90
new file mode 100644 (file)
index 0000000..3b488ce
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/module_write_1.f90
@@ -0,0 +1,59 @@
+! { dg-do compile }
+!
+! PR fortran/41869
+!
+! Was ICEing while module write of symbol 'vs_str' in m_dom_dom
+! because of "len" being private in fox_m_fsys_format.
+!
+module fox_m_fsys_array_str
+contains
+  pure function str_vs(vs) result(s)
+    character, dimension(:), intent(in) :: vs
+    character(len=size(vs)) :: s
+    s = transfer(vs, s)
+  end function str_vs
+  pure function vs_str(s) result(vs)
+    character(len=*), intent(in) :: s
+    character, dimension(len(s)) :: vs
+    vs = transfer(s, vs)
+  end function vs_str
+end module fox_m_fsys_array_str
+
+module fox_m_fsys_format
+  private
+  interface str
+    module procedure  str_logical_array
+  end interface str
+  interface len
+    module procedure str_logical_array_len
+  end interface
+  public :: str
+contains
+  pure function str_logical_array_len(la) result(n)
+    logical, dimension(:), intent(in)   :: la
+  end function str_logical_array_len
+  pure function str_logical_array(la) result(s)
+    logical, dimension(:), intent(in)   :: la
+    character(len=len(la)) :: s
+  end function str_logical_array
+  pure function checkFmt(fmt) result(good)
+    character(len=*), intent(in) :: fmt
+    logical :: good
+    good = len(fmt) > 0
+  end function checkFmt
+end module fox_m_fsys_format
+
+module m_dom_dom
+  use fox_m_fsys_array_str, only: str_vs, vs_str
+end module m_dom_dom
+
+module FoX_dom
+  use fox_m_fsys_format
+  use m_dom_dom
+end module FoX_dom
+
+use FoX_dom
+implicit none
+print *, vs_str("ABC")
+end
+! { dg-final { cleanup-modules "fox_m_fsys_array_str fox_m_fsys_format m_dom_dom fox_dom" } }