gcc/testsuite/gfortran.dg/typebound_call_4.f03

   1 ! { dg-do compile }
   2
   3 ! Type-bound procedures
   4 ! Check for recognition/errors with more complicated references and some
   5 ! error-handling in general.
   6
   7 MODULE m
   8   IMPLICIT NONE
   9
  10   TYPE t
  11   CONTAINS
  12     PROCEDURE, PASS :: proc
  13     PROCEDURE, NOPASS :: func
  14   END TYPE t
  15
  16   TYPE compt
  17     TYPE(t) :: myobj
  18   END TYPE compt
  19
  20 CONTAINS
  21
  22   SUBROUTINE proc (me)
  23     IMPLICIT NONE
  24     CLASS(t), INTENT(INOUT) :: me
  25   END SUBROUTINE proc
  26
  27   INTEGER FUNCTION func ()
  28     IMPLICIT NONE
  29     func = 1812
  30   END FUNCTION func
  31
  32   SUBROUTINE test ()
  33     IMPLICIT NONE
  34     TYPE(compt) :: arr(2)
  35
  36     ! These two are OK.
  37     CALL arr(1)%myobj%proc ()
  38     WRITE (*,*) arr(2)%myobj%func ()
  39
  40     ! Can't CALL a function or take the result of a SUBROUTINE.
  41     CALL arr(1)%myobj%func () ! { dg-error "SUBROUTINE" }
  42     WRITE (*,*) arr(2)%myobj%proc () ! { dg-error "FUNCTION" }
  43
  44     ! Error.
  45     CALL arr(2)%myobj%proc () x ! { dg-error "Junk after" }
  46     WRITE (*,*) arr(1)%myobj%func ! { dg-error "Expected argument list" }
  47   END SUBROUTINE test
  48
  49 END MODULE m