flang/test/Semantics/resolve96.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2
   3 ! Check distinguishability for specific procedures of defined operators and
   4 ! assignment. These are different from names because there a normal generic
   5 ! is invoked the same way as a type-bound generic.
   6 ! E.g. for a generic name like 'foo', the generic name is invoked as 'foo(x, y)'
   7 ! while the type-bound generic is invoked as 'x%foo(y)'.
   8 ! But for 'operator(.foo.)', it is 'x .foo. y' in either case.
   9 ! So to check the specifics of 'operator(.foo.)' we have to consider all
  10 ! definitions of it visible in the current scope.
  11
  12 ! One operator(.foo.) comes from interface-stmt, the other is type-bound.
  13 module m1
  14   type :: t1
  15   contains
  16     procedure, pass :: p => s1
  17     generic :: operator(.foo.) => p
  18   end type
  19   type :: t2
  20   end type
  21   !ERROR: Generic 'OPERATOR(.foo.)' may not have specific procedures 's2' and 't1%p' as their interfaces are not distinguishable
  22   interface operator(.foo.)
  23     procedure :: s2
  24   end interface
  25 contains
  26   integer function s1(x1, x2)
  27     class(t1), intent(in) :: x1
  28     class(t2), intent(in) :: x2
  29   end
  30   integer function s2(x1, x2)
  31     class(t1), intent(in) :: x1
  32     class(t2), intent(in) :: x2
  33   end
  34 end module
  35
  36 ! assignment(=) as type-bound generic in each type
  37 module m2
  38   type :: t1
  39     integer :: n
  40   contains
  41     procedure, pass(x1) :: p1 => s1
  42     !ERROR: Generic 'assignment(=)' may not have specific procedures 't1%p1' and 't2%p2' as their interfaces are not distinguishable
  43     generic :: assignment(=) => p1
  44   end type
  45   type :: t2
  46     integer :: n
  47   contains
  48     procedure, pass(x2) :: p2 => s2
  49     generic :: assignment(=) => p2
  50   end type
  51 contains
  52   subroutine s1(x1, x2)
  53     class(t1), intent(out) :: x1
  54     class(t2), intent(in) :: x2
  55     x1%n = x2%n + 1
  56   end subroutine
  57   subroutine s2(x1, x2)
  58     class(t1), intent(out) :: x1
  59     class(t2), intent(in) :: x2
  60     x1%n = x2%n + 2
  61   end subroutine
  62 end module