gcc/testsuite/gfortran.dg/interface_14.f90

   1 ! { dg-do compile }
   2 ! Checks the fix for a regression PR32526, which was caused by
   3 ! the patch for PR31494.  The problem here was that the symbol
   4 ! 'new' was determined to be ambiguous.
   5 !
   6 ! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
   7 !
   8     module P_Class
   9       implicit none
  10       private :: init_Personnel
  11       interface new
  12          module procedure init_Personnel
  13       end interface
  14       contains
  15          subroutine init_Personnel(this)
  16          integer, intent (in) :: this
  17          print *, "init personnel", this
  18          end subroutine init_Personnel
  19     end module P_Class
  20
  21     module S_Class
  22       use P_Class
  23       implicit none
  24       private :: init_Student
  25       type Student
  26          private
  27          integer :: personnel = 1
  28       end type Student
  29       interface new
  30          module procedure init_Student
  31       end interface
  32       contains
  33          subroutine init_Student(this)
  34          type (Student), intent (in) :: this
  35          call new(this%personnel)
  36          end subroutine init_Student
  37     end module S_Class
  38
  39     module T_Class
  40       use P_Class
  41       implicit none
  42       private :: init_Teacher
  43       type Teacher
  44          private
  45          integer :: personnel = 2
  46       end type Teacher
  47       interface new
  48          module procedure init_Teacher
  49       end interface
  50       contains
  51          subroutine init_Teacher(this)
  52          type (Teacher), intent (in) :: this
  53          call new(this%personnel)
  54          end subroutine init_Teacher
  55     end module T_Class
  56
  57     module poly_Class
  58       use S_Class
  59       use T_Class
  60     end module poly_Class
  61
  62     module D_Class
  63       use poly_Class
  64     end module D_Class
  65
  66       use D_Class
  67       type (Teacher) :: a
  68       type (Student) :: b
  69       call new (a)
  70       call new (b)
  71       end
  72
  73 ! { dg-final { cleanup-modules "P_class S_Class T_Class D_Class poly_Class" } }