Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/contained_3.f90 @ 128:fe568345ddd5
fix CbC-example
author | mir3636 |
---|---|
date | Wed, 11 Apr 2018 19:32:28 +0900 |
parents | 04ced10e8804 |
children | 84e7813d76e9 |
line wrap: on
line source
! { dg-do run } ! Tests the fix for PR33897, in which gfortran missed that the ! declaration of 'setbd' in 'nxtstg2' made it external. Also ! the ENTRY 'setbd' would conflict with the external 'setbd'. ! ! Contributed by Michael Richmond <michael.a.richmond@nasa.gov> ! MODULE ksbin1_aux_mod CONTAINS SUBROUTINE nxtstg1() INTEGER :: i i = setbd() ! available by host association. if (setbd () .ne. 99 ) call abort () END SUBROUTINE nxtstg1 SUBROUTINE nxtstg2() INTEGER :: i integer :: setbd ! makes it external. i = setbd() ! this is the PR if (setbd () .ne. 42 ) call abort () END SUBROUTINE nxtstg2 FUNCTION binden() INTEGER :: binden INTEGER :: setbd binden = 0 ENTRY setbd() setbd = 99 END FUNCTION binden END MODULE ksbin1_aux_mod PROGRAM test USE ksbin1_aux_mod, only : nxtstg1, nxtstg2 integer setbd ! setbd is external, since not use assoc. CALL nxtstg1() CALL nxtstg2() if (setbd () .ne. 42 ) call abort () call foo contains subroutine foo USE ksbin1_aux_mod ! module setbd is available if (setbd () .ne. 99 ) call abort () end subroutine END PROGRAM test INTEGER FUNCTION setbd() setbd=42 END FUNCTION setbd