gcc/testsuite/gfortran.dg/typebound_call_3.f03

   1 ! { dg-do run }
   2
   3 ! Type-bound procedures
   4 ! Check that calls work across module-boundaries.
   5
   6 MODULE m
   7   IMPLICIT NONE
   8
   9   TYPE trueOrFalse
  10     LOGICAL :: val
  11   CONTAINS
  12     PROCEDURE, PASS :: swap
  13   END TYPE trueOrFalse
  14
  15 CONTAINS
  16
  17   SUBROUTINE swap (me1, me2)
  18     IMPLICIT NONE
  19     CLASS(trueOrFalse), INTENT(INOUT) :: me1, me2
  20
  21     IF (.NOT. me1%val .OR. me2%val) THEN
  22       STOP 1
  23     END IF
  24
  25     me1%val = .FALSE.
  26     me2%val = .TRUE.
  27   END SUBROUTINE swap
  28
  29 END MODULE m
  30
  31 PROGRAM main
  32   USE m, ONLY: trueOrFalse
  33   IMPLICIT NONE
  34
  35   TYPE(trueOrFalse) :: t, f
  36
  37   t%val = .TRUE.
  38   f%val = .FALSE.
  39
  40   CALL t%swap (f)
  41   CALL f%swap (t)
  42
  43   IF (.NOT. t%val .OR. f%val) THEN
  44     STOP 2
  45   END IF
  46 END PROGRAM main