flang/test/Semantics/resolve38.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! C772
   3 module m1
   4   type t1
   5   contains
   6     procedure, nopass :: s1
   7     !ERROR: Binding name 's2' not found in this derived type
   8     generic :: g1 => s2
   9   end type
  10   type t2
  11     integer :: s1
  12   contains
  13     !ERROR: 's1' is not the name of a specific binding of this type
  14     generic :: g2 => s1
  15   end type
  16 contains
  17   subroutine s1
  18   end
  19 end
  20
  21 module m2
  22   type :: t3
  23   contains
  24     private
  25     procedure, nopass :: s3
  26     generic, public :: g3 => s3
  27     generic :: h3 => s3
  28   end type
  29 contains
  30   subroutine s3(i)
  31   end
  32 end
  33
  34 ! C771
  35 module m3
  36   use m2
  37   type, extends(t3) :: t4
  38   contains
  39     procedure, nopass :: s4
  40     procedure, nopass :: s5
  41     !ERROR: 'g3' does not have the same accessibility as its previous declaration
  42     generic, private :: g3 => s4
  43     !ERROR: 'h3' does not have the same accessibility as its previous declaration
  44     generic, public :: h3 => s4
  45     generic :: i3 => s4
  46     !ERROR: 'i3' does not have the same accessibility as its previous declaration
  47     generic, private :: i3 => s5
  48   end type
  49   type :: t5
  50   contains
  51     private
  52     procedure, nopass :: s3
  53     procedure, nopass :: s4
  54     procedure, nopass :: s5
  55     generic :: g5 => s3, s4
  56     !ERROR: 'g5' does not have the same accessibility as its previous declaration
  57     generic, public :: g5 => s5
  58   end type
  59 contains
  60   subroutine s4(r)
  61   end
  62   subroutine s5(z)
  63     complex :: z
  64   end
  65 end
  66
  67 ! Test forward reference in type-bound generic to binding is allowed
  68 module m4
  69   type :: t1
  70   contains
  71     generic :: g => s1
  72     generic :: g => s2
  73     procedure, nopass :: s1
  74     procedure, nopass :: s2
  75   end type
  76   type :: t2
  77   contains
  78     generic :: g => p1
  79     generic :: g => p2
  80     procedure, nopass :: p1 => s1
  81     procedure, nopass :: p2 => s2
  82   end type
  83 contains
  84   subroutine s1()
  85   end
  86   subroutine s2(x)
  87   end
  88 end
  89
  90 ! C773 - duplicate binding names
  91 module m5
  92   type :: t1
  93   contains
  94     generic :: g => s1
  95     generic :: g => s2
  96     procedure, nopass :: s1
  97     procedure, nopass :: s2
  98     !ERROR: Binding name 's1' was already specified for generic 'g'
  99     generic :: g => s1
 100   end type
 101 contains
 102   subroutine s1()
 103   end
 104   subroutine s2(x)
 105   end
 106 end
 107
 108 module m6
 109   type t
 110   contains
 111     procedure :: f1
 112     procedure :: f2
 113     generic :: operator(.eq.) => f1
 114     !ERROR: Binding name 'f1' was already specified for generic 'operator(.eq.)'
 115     generic :: operator(==) => f2, f1
 116   end type
 117 contains
 118   logical function f1(x, y) result(result)
 119     class(t), intent(in) :: x
 120     real, intent(in) :: y
 121     result = .true.
 122   end
 123   logical function f2(x, y) result(result)
 124     class(t), intent(in) :: x
 125     integer, intent(in) :: y
 126     result = .true.
 127   end
 128 end