gcc/testsuite/gfortran.dg/host_assoc_function_7.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR38907, in which any expressions, including unary plus,
   3 ! in front of the call to S_REAL_SUM_I (marked) would throw the mechanism
   4 ! for correcting invalid host association.
   5 !
   6 ! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
   7 !
   8 module sa0054_stuff
   9   REAL :: S_REAL_SUM_2(10) = [(REAL (I), I = 1, 10)]
  10 contains
  11   ELEMENTAL FUNCTION S_REAL_SUM_I (A)
  12     REAL  ::  S_REAL_SUM_I
  13     REAL, INTENT(IN)  ::  A
  14     X = 1.0
  15     S_REAL_SUM_I = X
  16   END FUNCTION S_REAL_SUM_I
  17   SUBROUTINE SA0054 (RDA)
  18     REAL RDA(:)
  19     RDA =  + S_REAL_SUM_I (RDA)          ! Reported problem => ICE
  20     RDA = RDA + S_REAL_SUM_2 (INT (RDA)) ! Also failed
  21   CONTAINS
  22     ELEMENTAL FUNCTION S_REAL_SUM_I (A)
  23       REAL  ::  S_REAL_SUM_I
  24       REAL, INTENT(IN)  ::  A
  25       S_REAL_SUM_I = 2.0 * A
  26     END FUNCTION S_REAL_SUM_I
  27     ELEMENTAL FUNCTION S_REAL_SUM_2 (A)
  28       REAL  ::  S_REAL_SUM_2
  29       INTEGER, INTENT(IN)  ::  A
  30       S_REAL_SUM_2 = 2.0 * A
  31     END FUNCTION S_REAL_SUM_2
  32   END SUBROUTINE
  33 end module sa0054_stuff
  34
  35   use sa0054_stuff
  36   REAL :: RDA(10) = [(REAL(I), I = 1, 10)]
  37   call SA0054 (RDA)
  38   IF (ANY (INT (RDA) .ne. [(6 * I, I = 1, 10)])) print *, rda
  39 END
  40
  41 ! { dg-final { cleanup-modules "sa0054_stuff" } }