gcc/testsuite/gfortran.dg/entry_16.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR33499 in which the ENTRY cx_radc was not
   3 ! getting its TYPE.
   4 !
   5 ! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
   6 !
   7 MODULE complex
   8   IMPLICIT NONE
   9   PRIVATE
  10   PUBLIC :: cx, OPERATOR(+), OPERATOR(.eq.)
  11   TYPE cx
  12     integer :: re
  13     integer :: im
  14   END TYPE cx
  15   INTERFACE OPERATOR (+)
  16     MODULE PROCEDURE cx_cadr, cx_radc
  17   END INTERFACE
  18   INTERFACE OPERATOR (.eq.)
  19     MODULE PROCEDURE cx_eq
  20   END INTERFACE
  21   CONTAINS
  22   FUNCTION cx_cadr(z, r)
  23   ENTRY cx_radc(r, z)
  24     TYPE (cx) :: cx_cadr, cx_radc
  25     TYPE (cx), INTENT(IN) :: z
  26     integer, INTENT(IN) :: r
  27     cx_cadr%re = z%re + r
  28     cx_cadr%im = z%im
  29   END FUNCTION cx_cadr
  30   FUNCTION cx_eq(u, v)
  31     TYPE (cx), INTENT(IN) :: u, v
  32     logical :: cx_eq
  33     cx_eq = (u%re .eq. v%re) .and. (u%im .eq. v%im)
  34   END FUNCTION cx_eq
  35 END MODULE complex
  36
  37   use complex
  38   type(cx) :: a = cx (1, 2), c, d
  39   logical :: f
  40   integer :: b = 3
  41   if (.not.((a + b) .eq. (b + a))) call abort ()
  42   if (.not.((a + b) .eq. cx (4, 2))) call abort ()
  43 end