re PR fortran/60359 ([OOP] symbol `__io_MOD___copy_character_1' is already defined)

2014-02-28  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/60359
	* class.c (find_intrinsic_vtab): Prevent duplicate creation of copy
	procedure for characters.

2014-02-28  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/60359
	* gfortran.dg/unlimited_polymorphic_16.f90: New.

From-SVN: r208227

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 995ede78f833cc86939ea07fa4d847fbd7c6a1c3..415a4cbaedf5d25b454c45a5b29c2fa322dccb3d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2014-02-28  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/60359
+       * class.c (find_intrinsic_vtab): Prevent duplicate creation of copy
+       procedure for characters.
+
 2014-02-21  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/60302

diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index fc228cfde1b0e7b88b0b5cb40cba167384bf8a25..d01d7d8c97a975017c1213e1fbc6f15cf1bb52f6 100644 (file)
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -2532,17 +2532,22 @@ find_intrinsic_vtab (gfc_typespec *ts)
              c->tb = XCNEW (gfc_typebound_proc);
              c->tb->ppc = 1;
 
-             /* Check to see if copy function already exists.  Note
-                that this is only used for characters of different
-                lengths.  */
-             contained = ns->contained;
-             for (; contained; contained = contained->sibling)
-               if (contained->proc_name
-                   && strcmp (name, contained->proc_name->name) == 0)
-                 {
-                   copy = contained->proc_name;
-                   goto got_char_copy;
-                 }
+             if (ts->type != BT_CHARACTER)
+               sprintf (name, "__copy_%s", tname);
+             else
+               {
+                 /* __copy is always the same for characters.
+                    Check to see if copy function already exists.  */
+                 sprintf (name, "__copy_character_%d", ts->kind);
+                 contained = ns->contained;
+                 for (; contained; contained = contained->sibling)
+                   if (contained->proc_name
+                       && strcmp (name, contained->proc_name->name) == 0)
+                     {
+                       copy = contained->proc_name;
+                       goto got_char_copy;
+                     }
+               }
 
              /* Set up namespace.  */
              sub_ns = gfc_get_namespace (ns, 0);
@@ -2550,11 +2555,6 @@ find_intrinsic_vtab (gfc_typespec *ts)
              ns->contained = sub_ns;
              sub_ns->resolved = 1;
              /* Set up procedure symbol.  */
-             if (ts->type != BT_CHARACTER)
-               sprintf (name, "__copy_%s", tname);
-             else
-               /* __copy is always the same for characters.  */
-               sprintf (name, "__copy_character_%d", ts->kind);
              gfc_get_symbol (name, sub_ns, &copy);
              sub_ns->proc_name = copy;
              copy->attr.flavor = FL_PROCEDURE;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3011092bc2ebcfa85135a6898d758044cc4b5777..5a831bfdd5cc5cfc73c7b82291805bd48bab0c4a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2014-02-28  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/60359
+       * gfortran.dg/unlimited_polymorphic_16.f90: New.
+
 2014-02-28  Paolo Carlini  <paolo.carlini@oracle.com>
 
        PR c++/58610

diff --git a/gcc/testsuite/gfortran.dg/unlimited_polymorphic_16.f90 b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_16.f90
new file mode 100644 (file)
index 0000000..99e186d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/unlimited_polymorphic_16.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+!
+! PR 60359: [OOP] symbol `__io_MOD___copy_character_1' is already defined
+!
+! Contributed by Antony Lewis <antony@cosmologist.info>
+
+module IO
+implicit none
+
+contains
+
+  subroutine FWRite(S)
+    class(*) :: S
+  end subroutine
+
+  subroutine IO_OutputMargeStats()
+    character(len=128) tag
+    call FWrite(tag)
+    call FWrite(' '//tag)
+  end subroutine
+
+end module
+
+! { dg-final { cleanup-modules "IO" } }