gcc/testsuite/gfortran.dg/typebound_proc_16.f03

   1 ! { dg-do compile }
   2 !
   3 ! PR 44549: [OOP][F2008] Type-bound procedure: bogus error from list after PROCEDURE
   4 !
   5 ! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
   6
   7 MODULE rational_numbers
   8   IMPLICIT NONE
   9   PRIVATE
  10   TYPE,PUBLIC :: rational
  11     PRIVATE
  12     INTEGER n,d
  13
  14     CONTAINS
  15     ! ordinary type-bound procedure
  16     PROCEDURE :: real => rat_to_real
  17     ! specific type-bound procedures for generic support
  18     PROCEDURE,PRIVATE :: rat_asgn_i, rat_plus_rat, rat_plus_i
  19     PROCEDURE,PRIVATE,PASS(b) :: i_plus_rat
  20     ! generic type-bound procedures
  21     GENERIC :: ASSIGNMENT(=) => rat_asgn_i
  22     GENERIC :: OPERATOR(+) => rat_plus_rat, rat_plus_i, i_plus_rat
  23   END TYPE
  24   CONTAINS
  25     ELEMENTAL REAL FUNCTION rat_to_real(this) RESULT(r)
  26       CLASS(rational),INTENT(IN) :: this
  27       r = REAL(this%n)/this%d
  28     END FUNCTION
  29
  30     impure ELEMENTAL SUBROUTINE rat_asgn_i(a,b)
  31       CLASS(rational),INTENT(OUT) :: a
  32       INTEGER,INTENT(IN) :: b
  33       a%n = b
  34       a%d = 1
  35     END SUBROUTINE
  36
  37     ELEMENTAL TYPE(rational) FUNCTION rat_plus_i(a,b) RESULT(r)
  38       CLASS(rational),INTENT(IN) :: a
  39       INTEGER,INTENT(IN) :: b
  40       r%n = a%n + b*a%d
  41       r%d = a%d
  42     END FUNCTION
  43
  44     ELEMENTAL TYPE(rational) FUNCTION i_plus_rat(a,b) RESULT(r)
  45       INTEGER,INTENT(IN) :: a
  46       CLASS(rational),INTENT(IN) :: b
  47       r%n = b%n + a*b%d
  48       r%d = b%d
  49     END FUNCTION
  50
  51     ELEMENTAL TYPE(rational) FUNCTION rat_plus_rat(a,b) RESULT(r)
  52       CLASS(rational),INTENT(IN) :: a,b
  53       r%n = a%n*b%d + b%n*a%d
  54       r%d = a%d*b%d
  55     END FUNCTION
  56 END