gcc/testsuite/gfortran.dg/use_only_1.f90

! { dg-do run }
! { dg-options "-O1" }
! Checks the fix for PR33541, in which a requirement of
! F95 11.3.2 was not being met: The local names 'x' and
! 'y' coming from the USE statements without an ONLY clause
! should not survive in the presence of the locally renamed
! versions. In fixing the PR, the same correction has been
! made to generic interfaces.
!
! Reported by Reported by John Harper in
! http://gcc.gnu.org/ml/fortran/2007-09/msg00397.html
!
MODULE xmod
  integer(4) :: x = -666
  private foo, bar
  interface xfoobar
    module procedure foo, bar
  end interface
contains
  integer function foo ()
    foo = 42
  end function
  integer function bar (a)
    integer a
    bar = a
  end function
END MODULE xmod

MODULE ymod
  integer(4) :: y = -666
  private foo, bar
  interface yfoobar
    module procedure foo, bar
  end interface
contains
  integer function foo ()
    foo = 42
  end function
  integer function bar (a)
    integer a
    bar = a
  end function
END MODULE ymod

  integer function xfoobar () ! These function as defaults should...
    xfoobar = 99
  end function

  integer function yfoobar () ! ...the rename works correctly.
    yfoobar = 99
  end function

PROGRAM test2uses
  implicit integer(2) (a-z)
  x = 666  ! These assignments generate implicitly typed
  y = 666  ! local variables 'x' and 'y'.
  call test1
  call test2
  call test3
contains
  subroutine test1  ! Test the fix of the original PR
    USE xmod
    USE xmod, ONLY: xrenamed => x
    USE ymod, ONLY: yrenamed => y
    USE ymod
    implicit integer(2) (a-z)
    if (kind(xrenamed) == kind(x)) STOP 1
    if (kind(yrenamed) == kind(y)) STOP 2
  end subroutine

  subroutine test2  ! Test the fix applies to generic interfaces
    USE xmod
    USE xmod, ONLY: xfoobar_renamed => xfoobar
    USE ymod, ONLY: yfoobar_renamed => yfoobar
    USE ymod
    implicit integer(4) (a-z)
    if (xfoobar_renamed (42) == xfoobar ()) STOP 3
    if (yfoobar_renamed (42) == yfoobar ()) STOP 4
  end subroutine

  subroutine test3  ! Check that USE_NAME == LOCAL_NAME is OK
    USE xmod
    USE xmod, ONLY: x => x, xfoobar => xfoobar
    USE ymod, ONLY: y => y, yfoobar => yfoobar
    USE ymod
    if (kind (x) /= 4) STOP 5    
    if (kind (y) /= 4) STOP 6    
    if (xfoobar (77) /= 77_4) STOP 7
    if (yfoobar (77) /= 77_4) STOP 8
  end subroutine
END PROGRAM test2uses