gcc/testsuite/gfortran.dg/typebound_proc_13.f03

   1 ! { dg-do compile }
   2
   3 ! PR fortran/41177
   4 ! Test for additional errors with type-bound procedure bindings.
   5 ! Namely that non-scalar base objects are rejected for TBP calls which are
   6 ! NOPASS, and that passed-object dummy arguments must be scalar, non-POINTER
   7 ! and non-ALLOCATABLE.
   8
   9 MODULE m
  10   IMPLICIT NONE
  11
  12   TYPE t
  13   CONTAINS
  14     PROCEDURE, NOPASS :: myproc
  15   END TYPE t
  16
  17   TYPE t2
  18   CONTAINS
  19     PROCEDURE, PASS :: nonscalar ! { dg-error "must be scalar" }
  20     PROCEDURE, PASS :: is_pointer ! { dg-error "must not be POINTER" }
  21     PROCEDURE, PASS :: is_allocatable ! { dg-error "must not be ALLOCATABLE" }
  22   END TYPE t2
  23
  24 CONTAINS
  25
  26   SUBROUTINE myproc ()
  27   END SUBROUTINE myproc
  28
  29   SUBROUTINE nonscalar (me)
  30     CLASS(t2), INTENT(IN) :: me(:)
  31   END SUBROUTINE nonscalar
  32
  33   SUBROUTINE is_pointer (me)
  34     CLASS(t2), POINTER, INTENT(IN) :: me
  35   END SUBROUTINE is_pointer
  36
  37   SUBROUTINE is_allocatable (me)
  38     CLASS(t2), ALLOCATABLE, INTENT(IN) :: me
  39   END SUBROUTINE is_allocatable
  40
  41   SUBROUTINE test ()
  42     TYPE(t) :: arr(2)
  43     CALL arr%myproc () ! { dg-error "must be scalar" }
  44   END SUBROUTINE test
  45
  46 END MODULE m