gcc/testsuite/gfortran.dg/class_nameclash.f90

   1 ! { dg-do run }
   2 !
   3 ! try to provoke class name clashes in gfc_build_class_symbol
   4 !
   5 module test_module
   6
   7   implicit none
   8
   9   type, public :: test_p
  10     private
  11     class (test_p), pointer :: next => null()
  12   end type test_p
  13
  14   type, public :: test
  15 !   Error in "call do_it (x)" below:
  16 !   Type mismatch in argument 'x' at (1); passed CLASS(test_p) to CLASS(test)
  17     class (test), pointer :: next => null()
  18   end type test
  19
  20 contains
  21
  22   subroutine do_it (x)
  23     class (test_p), target :: x
  24
  25     x%next => x
  26     return
  27   end subroutine do_it
  28
  29 end module test_module
  30
  31 use test_module
  32
  33   implicit none
  34   class (test_p), pointer :: x
  35
  36   allocate (x)
  37   call do_it (x)
  38   deallocate (x)
  39 end