diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 4e1ef1f3e47..89f4e04943f 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,8 @@ +2014-04-10 Bernd Edlinger + + * fortran/class.c (gfc_build_class_symbol): Append "_t" to target class + names to make the generated type names unique. + 2014-04-10 Ramana Radhakrishnan PR debug/60655 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index d01d7d8c97a..346aee65205 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -588,13 +588,13 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr, else if ((*as) && attr->pointer) sprintf (name, "__class_%s_%d_%dp", tname, rank, (*as)->corank); else if ((*as)) - sprintf (name, "__class_%s_%d_%d", tname, rank, (*as)->corank); + sprintf (name, "__class_%s_%d_%dt", tname, rank, (*as)->corank); else if (attr->pointer) sprintf (name, "__class_%s_p", tname); else if (attr->allocatable) sprintf (name, "__class_%s_a", tname); else - sprintf (name, "__class_%s", tname); + sprintf (name, "__class_%s_t", tname); if (ts->u.derived->attr.unlimited_polymorphic) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7cab549663f..4db6ed06ad9 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2014-04-10 Bernd Edlinger + + * gfortran.dg/class_nameclash.f90: New test. + 2014-04-10 Paolo Carlini PR c++/52844 diff --git a/gcc/testsuite/gfortran.dg/class_nameclash.f90 b/gcc/testsuite/gfortran.dg/class_nameclash.f90 new file mode 100644 index 00000000000..227d865962f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_nameclash.f90 @@ -0,0 +1,39 @@ +! { dg-do run } +! +! try to provoke class name clashes in gfc_build_class_symbol +! +module test_module + + implicit none + + type, public :: test_p + private + class (test_p), pointer :: next => null() + end type test_p + + type, public :: test +! Error in "call do_it (x)" below: +! Type mismatch in argument 'x' at (1); passed CLASS(test_p) to CLASS(test) + class (test), pointer :: next => null() + end type test + +contains + + subroutine do_it (x) + class (test_p), target :: x + + x%next => x + return + end subroutine do_it + +end module test_module + +use test_module + + implicit none + class (test_p), pointer :: x + + allocate (x) + call do_it (x) + deallocate (x) +end