gcc/testsuite/gfortran.dg/generic_18.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! Test the fix for PR40443 in which the final call to the generic
   5 ! 'SpecElem' was resolved to the elemental rather than the specific
   6 ! procedure, which is required by the second part of 12.4.4.1.
   7 !
   8 ! Contributed by Ian Harvey <ian_harvey@bigpond.com>
   9 !
  10 MODULE SomeOptions
  11   IMPLICIT NONE
  12   INTERFACE ElemSpec
  13     MODULE PROCEDURE ElemProc
  14     MODULE PROCEDURE SpecProc
  15   END INTERFACE ElemSpec
  16   INTERFACE SpecElem
  17     MODULE PROCEDURE SpecProc
  18     MODULE PROCEDURE ElemProc
  19   END INTERFACE SpecElem
  20 CONTAINS
  21   ELEMENTAL SUBROUTINE ElemProc(a)
  22     CHARACTER, INTENT(OUT) :: a
  23     !****
  24     a = 'E'
  25   END SUBROUTINE ElemProc
  26
  27   SUBROUTINE SpecProc(a)
  28     CHARACTER, INTENT(OUT) :: a(:)
  29     !****
  30     a = 'S'
  31   END SUBROUTINE SpecProc
  32 END MODULE SomeOptions
  33
  34 PROGRAM MakeAChoice
  35   USE SomeOptions
  36   IMPLICIT NONE
  37   CHARACTER scalar, array(2)
  38   !****
  39   CALL ElemSpec(scalar) ! Should choose the elemental (and does)
  40   WRITE (*, 100) scalar
  41   CALL ElemSpec(array)  ! Should choose the specific (and does)
  42   WRITE (*, 100) array
  43   !----
  44   CALL SpecElem(scalar) ! Should choose the elemental (and does)
  45   WRITE (*, 100) scalar
  46   CALL SpecElem(array)  ! Should choose the specific (but didn't)
  47   WRITE (*, 100) array
  48   !----
  49   100 FORMAT(A,:,', ',A)
  50 END PROGRAM MakeAChoice
  51 ! { dg-final { scan-tree-dump-times "specproc" 3 "original" } }
  52 ! { dg-final { scan-tree-dump-times "elemproc" 3 "original" } }
  53 ! { dg-final { cleanup-tree-dump "original" } }
  54 ! { dg-final { cleanup-modules "SomeOptions" } }