gcc/testsuite/gfortran.dg/elemental_dependency_5.f90

   1 ! { dg-do run }
   2 ! { dg-require-visibility "" }
   3 !
   4 ! Tests the fix for PR64952.
   5 !
   6 ! Original report by Nick Maclaren  <nmm1@cam.ac.uk> on clf
   7 ! https://groups.google.com/forum/#!topic/comp.lang.fortran/TvVY5j3GPmg
   8 ! See elemental_dependency_4.f90
   9 !
  10 ! This test contributed by Mikael Morin  <mikael.morin@sfr.fr>
  11 !
  12 MODULE M
  13     INTEGER, PRIVATE :: i
  14
  15     TYPE, ABSTRACT :: t
  16       REAL :: f
  17     CONTAINS
  18       PROCEDURE(Fred_ifc), DEFERRED, PASS :: tbp
  19     END TYPE t
  20     TYPE, EXTENDS(t) :: t2
  21     CONTAINS
  22       PROCEDURE :: tbp => Fred
  23     END TYPE t2
  24
  25     TYPE(t2) :: array(5) = (/ (t2(i+0.0), i = 1,5) /)
  26
  27     INTERFACE
  28         ELEMENTAL FUNCTION Fred_ifc (x, n)
  29             IMPORT
  30             REAL :: Fred
  31             CLASS(T), INTENT(IN) :: x
  32             INTEGER, INTENT(IN) :: n
  33         END FUNCTION Fred_ifc
  34     END INTERFACE
  35
  36 CONTAINS
  37     ELEMENTAL FUNCTION Fred (x, n)
  38         REAL :: Fred
  39         CLASS(T2), INTENT(IN) :: x
  40         INTEGER, INTENT(IN) :: n
  41         Fred = x%f+SUM(array(:n-1)%f)+SUM(array(n+1:)%f)
  42      END FUNCTION Fred
  43 END MODULE M
  44
  45 PROGRAM Main
  46     USE M
  47     INTEGER :: i, index(5) = (/ (i, i = 1,5) /)
  48
  49     array%f = array%tbp(index)
  50     if (any (array%f .ne. array(1)%f)) STOP 1
  51
  52     array%f = index
  53     call Jack(array)
  54   CONTAINS
  55     SUBROUTINE Jack(dummy)
  56         CLASS(t) :: dummy(:)
  57         dummy%f = dummy%tbp(index)
  58         !print *, dummy%f
  59         if (any (dummy%f .ne. 15.0)) STOP 2
  60     END SUBROUTINE
  61 END PROGRAM Main
  62