gcc/testsuite/gfortran.dg/typebound_operator_2.f03

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