flang/test/Semantics/resolve65.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Test restrictions on what subprograms can be used for defined assignment.
   3
   4 module m1
   5   implicit none
   6   type :: t
   7   contains
   8     !ERROR: Defined assignment procedure 'binding' must be a subroutine
   9     generic :: assignment(=) => binding
  10     procedure :: binding => assign_t1
  11     procedure :: assign_t
  12     procedure :: assign_t2
  13     procedure :: assign_t3
  14     !ERROR: Defined assignment subroutine 'assign_t2' must have two dummy arguments
  15     !ERROR: In defined assignment subroutine 'assign_t3', second dummy argument 'y' must have INTENT(IN) or VALUE attribute
  16     !ERROR: In defined assignment subroutine 'assign_t4', first dummy argument 'x' must have INTENT(OUT) or INTENT(INOUT)
  17     generic :: assignment(=) => assign_t, assign_t2, assign_t3, assign_t4
  18     procedure :: assign_t4
  19   end type
  20   type :: t2
  21   contains
  22     procedure, nopass :: assign_t
  23     !ERROR: Defined assignment procedure 'assign_t' may not have NOPASS attribute
  24     generic :: assignment(=) => assign_t
  25   end type
  26 contains
  27   subroutine assign_t(x, y)
  28     class(t), intent(out) :: x
  29     type(t), intent(in) :: y
  30   end
  31   logical function assign_t1(x, y)
  32     class(t), intent(out) :: x
  33     type(t), intent(in) :: y
  34   end
  35   subroutine assign_t2(x)
  36     class(t), intent(out) :: x
  37   end
  38   subroutine assign_t3(x, y)
  39     class(t), intent(out) :: x
  40     real :: y
  41   end
  42   subroutine assign_t4(x, y)
  43     class(t) :: x
  44       integer, intent(in) :: y
  45   end
  46 end
  47
  48 module m2
  49   type :: t
  50   end type
  51   !ERROR: Generic 'assignment(=)' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable
  52   interface assignment(=)
  53     !ERROR: In defined assignment subroutine 's1', dummy argument 'y' may not be OPTIONAL
  54     subroutine s1(x, y)
  55       import t
  56       type(t), intent(out) :: x
  57       real, optional, intent(in) :: y
  58     end
  59     !ERROR: In defined assignment subroutine 's2', dummy argument 'y' must be a data object
  60     subroutine s2(x, y)
  61       import t
  62       type(t), intent(out) :: x
  63       intent(in) :: y
  64       interface
  65         subroutine y()
  66         end
  67       end interface
  68     end
  69     !ERROR: In defined assignment subroutine 's3', second dummy argument 'y' must not be a pointer
  70     subroutine s3(x, y)
  71       import t
  72       type(t), intent(out) :: x
  73       type(t), intent(in), pointer :: y
  74     end
  75     !ERROR: In defined assignment subroutine 's4', second dummy argument 'y' must not be an allocatable
  76     subroutine s4(x, y)
  77       import t
  78       type(t), intent(out) :: x
  79       type(t), intent(in), allocatable :: y
  80     end
  81   end interface
  82 end
  83
  84 ! Detect defined assignment that conflicts with intrinsic assignment
  85 module m5
  86   type :: t
  87   end type
  88   interface assignment(=)
  89     ! OK - lhs is derived type
  90     subroutine assign_tt(x, y)
  91       import t
  92       type(t), intent(out) :: x
  93       type(t), intent(in) :: y
  94     end
  95     !OK - incompatible types
  96     subroutine assign_il(x, y)
  97       integer, intent(out) :: x
  98       logical, intent(in) :: y
  99     end
 100     !OK - different ranks
 101     subroutine assign_23(x, y)
 102       integer, intent(out) :: x(:,:)
 103       integer, intent(in) :: y(:,:,:)
 104     end
 105     !OK - scalar = array
 106     subroutine assign_01(x, y)
 107       integer, intent(out) :: x
 108       integer, intent(in) :: y(:)
 109     end
 110     !ERROR: Defined assignment subroutine 'assign_10' conflicts with intrinsic assignment
 111     subroutine assign_10(x, y)
 112       integer, intent(out) :: x(:)
 113       integer, intent(in) :: y
 114     end
 115     !ERROR: Defined assignment subroutine 'assign_ir' conflicts with intrinsic assignment
 116     subroutine assign_ir(x, y)
 117       integer, intent(out) :: x
 118       real, intent(in) :: y
 119     end
 120     !ERROR: Defined assignment subroutine 'assign_ii' conflicts with intrinsic assignment
 121     subroutine assign_ii(x, y)
 122       integer(2), intent(out) :: x
 123       integer(1), intent(in) :: y
 124     end
 125   end interface
 126 end