gcc/testsuite/gfortran.dg/typebound_operator_2.f03

   1 ! { dg-do compile }
   2
   3 ! Type-bound procedures
   4 ! Checks for correct errors with invalid OPERATOR/ASSIGNMENT usage.
   5
   6 MODULE m
   7   IMPLICIT NONE
   8
   9   TYPE t
  10   CONTAINS
  11     PROCEDURE, PASS :: onearg
  12     PROCEDURE, PASS :: onearg_alt => onearg
  13     PROCEDURE, PASS :: onearg_alt2 => onearg
  14     PROCEDURE, NOPASS :: nopassed => onearg
  15     PROCEDURE, PASS :: threearg
  16     PROCEDURE, PASS :: sub
  17     PROCEDURE, PASS :: sub2 ! { dg-error "must be a FUNCTION" }
  18     PROCEDURE, PASS :: func
  19
  20     ! These give errors at the targets' definitions.
  21     GENERIC :: OPERATOR(.AND.) => sub2
  22     GENERIC :: OPERATOR(*) => onearg
  23     GENERIC :: ASSIGNMENT(=) => func
  24
  25     GENERIC :: OPERATOR(.UOPA.) => sub ! { dg-error "must be a FUNCTION" }
  26     GENERIC :: OPERATOR(.UOPB.) => threearg ! { dg-error "at most, two arguments" }
  27     ! We can't check for the 'at least one argument' error, because in this case
  28     ! the procedure must be NOPASS and that other error is issued.  But of
  29     ! course this should be alright.
  30
  31     GENERIC :: OPERATOR(.UNARY.) => onearg_alt
  32     GENERIC, PRIVATE :: OPERATOR(.UNARY.) => onearg_alt2 ! { dg-error "must have the same access" }
  33
  34     GENERIC :: OPERATOR(.UNARYPRIME.) => nopassed ! { dg-error "can't be NOPASS" }
  35     GENERIC :: OPERATOR(-) => nopassed ! { dg-error "can't be NOPASS" }
  36   END TYPE t
  37
  38 CONTAINS
  39
  40   INTEGER FUNCTION onearg (me) ! { dg-error "wrong number of arguments" }
  41     CLASS(t), INTENT(IN) :: me
  42     onearg = 5
  43   END FUNCTION onearg
  44
  45   INTEGER FUNCTION threearg (a, b, c)
  46     CLASS(t), INTENT(IN) :: a, b, c
  47     threearg = 42
  48   END FUNCTION threearg
  49
  50   LOGICAL FUNCTION func (me, b) ! { dg-error "must be a SUBROUTINE" }
  51     CLASS(t), INTENT(OUT) :: me
  52     CLASS(t), INTENT(IN) :: b
  53     func = .TRUE.
  54   END FUNCTION func
  55
  56   SUBROUTINE sub (a)
  57     CLASS(t), INTENT(IN) :: a
  58   END SUBROUTINE sub
  59
  60   SUBROUTINE sub2 (a, x)
  61     CLASS(t), INTENT(IN) :: a
  62     INTEGER, INTENT(IN) :: x
  63   END SUBROUTINE sub2
  64
  65 END MODULE m
  66
  67 ! { dg-final { cleanup-modules "m" } }