flang/test/Semantics/resolve52.f90

   1 ! RUN: %python %S/test_errors.py %s %flang_fc1
   2 ! Tests for C760:
   3 ! The passed-object dummy argument shall be a scalar, nonpointer, nonallocatable
   4 ! dummy data object with the same declared type as the type being defined;
   5 ! all of its length type parameters shall be assumed; it shall be polymorphic
   6 ! (7.3.2.3) if and only if the type being defined is extensible (7.5.7).
   7 ! It shall not have the VALUE attribute.
   8 !
   9 ! C757 If the procedure pointer component has an implicit interface or has no
  10 ! arguments, NOPASS shall be specified.
  11 !
  12 ! C758 If PASS (arg-name) appears, the interface of the procedure pointer
  13 ! component shall have a dummy argument named arg-name.
  14
  15
  16 module m1
  17   type :: t
  18     procedure(real), pointer, nopass :: a
  19     !ERROR: Procedure component 'b' must have NOPASS attribute or explicit interface
  20     procedure(real), pointer :: b
  21   end type
  22 end
  23
  24 module m2
  25   type :: t
  26     !ERROR: Procedure component 'a' with no dummy arguments must have NOPASS attribute
  27     procedure(s1), pointer :: a
  28     !ERROR: Procedure component 'b' with no dummy arguments must have NOPASS attribute
  29     procedure(s1), pointer, pass :: b
  30   contains
  31     !ERROR: Procedure binding 'p1' with no dummy arguments must have NOPASS attribute
  32     procedure :: p1 => s1
  33     !ERROR: Procedure binding 'p2' with no dummy arguments must have NOPASS attribute
  34     procedure, pass :: p2 => s1
  35   end type
  36 contains
  37   subroutine s1()
  38   end
  39 end
  40
  41 module m3
  42   type :: t
  43     !ERROR: 'y' is not a dummy argument of procedure interface 's'
  44     procedure(s), pointer, pass(y) :: a
  45   contains
  46     !ERROR: 'z' is not a dummy argument of procedure interface 's'
  47     procedure, pass(z) :: p => s
  48   end type
  49 contains
  50   subroutine s(x)
  51     class(t) :: x
  52   end
  53 end
  54
  55 module m4
  56   type :: t
  57     !ERROR: Passed-object dummy argument 'x' of procedure 'a' may not have the POINTER attribute
  58     procedure(s1), pointer :: a
  59     !ERROR: Passed-object dummy argument 'x' of procedure 'b' may not have the ALLOCATABLE attribute
  60     procedure(s2), pointer, pass(x) :: b
  61     !ERROR: Passed-object dummy argument 'f' of procedure 'c' must be a data object
  62     procedure(s3), pointer, pass :: c
  63     !ERROR: Passed-object dummy argument 'x' of procedure 'd' must be scalar
  64     procedure(s4), pointer, pass :: d
  65   end type
  66 contains
  67   subroutine s1(x)
  68     class(t), pointer :: x
  69   end
  70   subroutine s2(w, x)
  71     real :: x
  72     !ERROR: The type of 'x' has already been declared
  73     class(t), allocatable :: x
  74   end
  75   subroutine s3(f)
  76     interface
  77       real function f()
  78       end function
  79     end interface
  80   end
  81   subroutine s4(x)
  82     class(t) :: x(10)
  83   end
  84 end
  85
  86 module m5
  87   type :: t1
  88     sequence
  89     !ERROR: Passed-object dummy argument 'x' of procedure 'a' must be of type 't1' but is 'REAL(4)'
  90     procedure(s), pointer :: a
  91   end type
  92   type :: t2
  93   contains
  94     !ERROR: Passed-object dummy argument 'y' of procedure 's' must be of type 't2' but is 'TYPE(t1)'
  95     procedure, pass(y) :: s
  96   end type
  97 contains
  98   subroutine s(x, y)
  99     real :: x
 100     type(t1) :: y
 101   end
 102 end
 103
 104 module m6
 105   type :: t(k, l)
 106     integer, kind :: k
 107     integer, len :: l
 108     !ERROR: Passed-object dummy argument 'x' of procedure 'a' has non-assumed length parameter 'l'
 109     procedure(s1), pointer :: a
 110   end type
 111 contains
 112   subroutine s1(x)
 113     class(t(1, 2)) :: x
 114   end
 115 end
 116
 117 module m7
 118   type :: t
 119     sequence  ! t is not extensible
 120     !ERROR: Passed-object dummy argument 'x' of procedure 'a' may not be polymorphic because 't' is not extensible
 121     procedure(s), pointer :: a
 122   end type
 123 contains
 124   subroutine s(x)
 125     !ERROR: Non-extensible derived type 't' may not be used with CLASS keyword
 126     class(t) :: x
 127   end
 128 end
 129
 130 module m8
 131   type :: t
 132   contains
 133     !ERROR: Passed-object dummy argument 'x' of procedure 's' must be polymorphic because 't' is extensible
 134     procedure :: s
 135   end type
 136 contains
 137   subroutine s(x)
 138     type(t) :: x  ! x is not polymorphic
 139   end
 140 end