gcc/testsuite/gfortran.dg/submodule_19.f08

   1 ! { dg-do compile }
   2 !
   3 ! Tests the fix for PR78108 in which an error was triggered by the
   4 ! generic operator being resolved more than once in submodules. This
   5 ! test checks that the error is triggered when the specific procedure
   6 ! really is inserted more than once in the interface.
   7 !
   8 ! Note that adding the extra interface to the module produces two
   9 ! errors; the one below and 'Duplicate EXTERNAL attribute specified at (1)'
  10 !
  11 ! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
  12 !
  13 module foo_interface
  14   implicit none
  15   type foo
  16     integer :: x
  17   contains
  18     procedure :: add
  19     generic :: operator(+) => add
  20     procedure :: mult
  21     generic :: operator(*) => mult
  22   end type
  23   interface
  24     integer module function add(lhs,rhs)
  25       implicit none
  26       class(foo), intent(in) :: lhs,rhs
  27     end function
  28     integer module function mult(lhs,rhs)
  29       implicit none
  30       class(foo), intent(in) :: lhs,rhs
  31     end function
  32   end interface
  33 end module
  34 submodule(foo_interface) foo_implementation
  35   interface operator (+)
  36     integer module function add(lhs,rhs)
  37       implicit none
  38       class(foo), intent(in) :: lhs,rhs
  39     end function    ! { dg-error "is already present in the interface" }
  40   end interface
  41 contains
  42     integer module function add(lhs,rhs)
  43       implicit none
  44       class(foo), intent(in) :: lhs,rhs
  45       add = lhs % x + rhs % x
  46     end function
  47     integer module function mult(lhs,rhs)
  48       implicit none
  49       class(foo), intent(in) :: lhs,rhs
  50       mult = lhs % x * rhs % x
  51     end function
  52 end submodule
  53
  54   use foo_interface
  55   type(foo) :: a = foo (42)
  56   type(foo) :: b = foo (99)
  57   if (a + b .ne. 141) call abort
  58   if (a * b .ne. 4158) call abort
  59 end