From 3c3f892bf083c7df33c50347ed106c54fc9ed941 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Fri, 28 Feb 2014 22:30:04 +0100 Subject: [PATCH] re PR fortran/60359 ([OOP] symbol `__io_MOD___copy_character_1' is already defined) 2014-02-28 Janus Weil PR fortran/60359 * class.c (find_intrinsic_vtab): Prevent duplicate creation of copy procedure for characters. 2014-02-28 Janus Weil PR fortran/60359 * gfortran.dg/unlimited_polymorphic_16.f90: New. From-SVN: r208227 --- gcc/fortran/ChangeLog | 6 ++++ gcc/fortran/class.c | 32 +++++++++---------- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/unlimited_polymorphic_16.f90 | 24 ++++++++++++++ 4 files changed, 51 insertions(+), 16 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/unlimited_polymorphic_16.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 995ede78f83..415a4cbaedf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2014-02-28 Janus Weil + + PR fortran/60359 + * class.c (find_intrinsic_vtab): Prevent duplicate creation of copy + procedure for characters. + 2014-02-21 Janus Weil PR fortran/60302 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index fc228cfde1b..d01d7d8c97a 100644 --- 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, ©); sub_ns->proc_name = copy; copy->attr.flavor = FL_PROCEDURE; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3011092bc2e..5a831bfdd5c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2014-02-28 Janus Weil + + PR fortran/60359 + * gfortran.dg/unlimited_polymorphic_16.f90: New. + 2014-02-28 Paolo Carlini 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 index 00000000000..99e186d5c14 --- /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 + +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" } }