flang/test/Semantics/resolve65.f90

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