gcc/testsuite/gfortran.dg/contained_3.f90

   1 ! { dg-do run }
   2 ! Tests the fix for PR33897, in which gfortran missed that the
   3 ! declaration of 'setbd' in 'nxtstg2' made it external.  Also
   4 ! the ENTRY 'setbd' would conflict with the external 'setbd'.
   5 !
   6 ! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
   7 !
   8 MODULE ksbin1_aux_mod
   9  CONTAINS
  10   SUBROUTINE nxtstg1()
  11     INTEGER :: i
  12     i = setbd()  ! available by host association.
  13     if (setbd () .ne. 99 ) call abort ()
  14   END SUBROUTINE nxtstg1
  15
  16   SUBROUTINE nxtstg2()
  17     INTEGER :: i
  18     integer :: setbd  ! makes it external.
  19     i = setbd()       ! this is the PR
  20     if (setbd () .ne. 42 ) call abort ()
  21   END SUBROUTINE nxtstg2
  22
  23   FUNCTION binden()
  24     INTEGER :: binden
  25     INTEGER :: setbd
  26     binden = 0
  27   ENTRY setbd()
  28     setbd = 99
  29   END FUNCTION binden
  30 END MODULE ksbin1_aux_mod
  31
  32 PROGRAM test
  33   USE ksbin1_aux_mod, only : nxtstg1, nxtstg2
  34   integer setbd ! setbd is external, since not use assoc.
  35   CALL nxtstg1()
  36   CALL nxtstg2()
  37   if (setbd () .ne. 42 ) call abort ()
  38   call foo
  39 contains
  40   subroutine foo
  41     USE ksbin1_aux_mod ! module setbd is available
  42     if (setbd () .ne. 99 ) call abort ()
  43   end subroutine
  44 END PROGRAM test
  45
  46 INTEGER FUNCTION setbd()
  47   setbd=42
  48 END FUNCTION setbd