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 ! FIXME: uncomment and dejagnuify once class arrays are enabled
  20 !    PROCEDURE, PASS :: nonscalar ! { "must be scalar" }
  21     PROCEDURE, PASS :: is_pointer ! { dg-error "must not be POINTER" }
  22     PROCEDURE, PASS :: is_allocatable ! { dg-error "must not be ALLOCATABLE" }
  23   END TYPE t2
  24
  25 CONTAINS
  26
  27   SUBROUTINE myproc ()
  28   END SUBROUTINE myproc
  29
  30 !  SUBROUTINE nonscalar (me)
  31 !    CLASS(t2), INTENT(IN) :: me(:)
  32 !  END SUBROUTINE nonscalar
  33
  34   SUBROUTINE is_pointer (me)
  35     CLASS(t2), POINTER, INTENT(IN) :: me
  36   END SUBROUTINE is_pointer
  37
  38   SUBROUTINE is_allocatable (me)
  39     CLASS(t2), ALLOCATABLE, INTENT(IN) :: me
  40   END SUBROUTINE is_allocatable
  41
  42   SUBROUTINE test ()
  43     TYPE(t) :: arr(2)
  44     CALL arr%myproc () ! { dg-error "must be scalar" }
  45   END SUBROUTINE test
  46
  47 END MODULE m
  48
  49 ! { dg-final { cleanup-modules "m" } }