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   interface assignment(=)
  52     !ERROR: In defined assignment subroutine 's1', dummy argument 'y' may not be OPTIONAL
  53     subroutine s1(x, y)
  54       import t
  55       type(t), intent(out) :: x
  56       real, optional, intent(in) :: y
  57     end
  58     !ERROR: In defined assignment subroutine 's2', dummy argument 'y' must be a data object
  59     subroutine s2(x, y)
  60       import t
  61       type(t), intent(out) :: x
  62       intent(in) :: y
  63       interface
  64         subroutine y()
  65         end
  66       end interface
  67     end
  68   end interface
  69 end
  70
  71 ! Detect defined assignment that conflicts with intrinsic assignment
  72 module m5
  73   type :: t
  74   end type
  75   interface assignment(=)
  76     ! OK - lhs is derived type
  77     subroutine assign_tt(x, y)
  78       import t
  79       type(t), intent(out) :: x
  80       type(t), intent(in) :: y
  81     end
  82     !OK - incompatible types
  83     subroutine assign_il(x, y)
  84       integer, intent(out) :: x
  85       logical, intent(in) :: y
  86     end
  87     !OK - different ranks
  88     subroutine assign_23(x, y)
  89       integer, intent(out) :: x(:,:)
  90       integer, intent(in) :: y(:,:,:)
  91     end
  92     !OK - scalar = array
  93     subroutine assign_01(x, y)
  94       integer, intent(out) :: x
  95       integer, intent(in) :: y(:)
  96     end
  97     !ERROR: Defined assignment subroutine 'assign_10' conflicts with intrinsic assignment
  98     subroutine assign_10(x, y)
  99       integer, intent(out) :: x(:)
 100       integer, intent(in) :: y
 101     end
 102     !ERROR: Defined assignment subroutine 'assign_ir' conflicts with intrinsic assignment
 103     subroutine assign_ir(x, y)
 104       integer, intent(out) :: x
 105       real, intent(in) :: y
 106     end
 107     !ERROR: Defined assignment subroutine 'assign_ii' conflicts with intrinsic assignment
 108     subroutine assign_ii(x, y)
 109       integer(2), intent(out) :: x
 110       integer(1), intent(in) :: y
 111     end
 112   end interface
 113 end