OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.dg/] [use_only_1.f90] - Blame information for rev 826

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn
! { dg-do run }
2
! { dg-options "-O1" }
3
! Checks the fix for PR33541, in which a requirement of
4
! F95 11.3.2 was not being met: The local names 'x' and
5
! 'y' coming from the USE statements without an ONLY clause
6
! should not survive in the presence of the locally renamed
7
! versions. In fixing the PR, the same correction has been
8
! made to generic interfaces.
9
!
10
! Reported by Reported by John Harper in
11
! http://gcc.gnu.org/ml/fortran/2007-09/msg00397.html
12
!
13
MODULE xmod
14
  integer(4) :: x = -666
15
  private foo, bar
16
  interface xfoobar
17
    module procedure foo, bar
18
  end interface
19
contains
20
  integer function foo ()
21
    foo = 42
22
  end function
23
  integer function bar (a)
24
    integer a
25
    bar = a
26
  end function
27
END MODULE xmod
28
 
29
MODULE ymod
30
  integer(4) :: y = -666
31
  private foo, bar
32
  interface yfoobar
33
    module procedure foo, bar
34
  end interface
35
contains
36
  integer function foo ()
37
    foo = 42
38
  end function
39
  integer function bar (a)
40
    integer a
41
    bar = a
42
  end function
43
END MODULE ymod
44
 
45
  integer function xfoobar () ! These function as defaults should...
46
    xfoobar = 99
47
  end function
48
 
49
  integer function yfoobar () ! ...the rename works correctly.
50
    yfoobar = 99
51
  end function
52
 
53
PROGRAM test2uses
54
  implicit integer(2) (a-z)
55
  x = 666  ! These assignments generate implicitly typed
56
  y = 666  ! local variables 'x' and 'y'.
57
  call test1
58
  call test2
59
  call test3
60
contains
61
  subroutine test1  ! Test the fix of the original PR
62
    USE xmod
63
    USE xmod, ONLY: xrenamed => x
64
    USE ymod, ONLY: yrenamed => y
65
    USE ymod
66
    implicit integer(2) (a-z)
67
    if (kind(xrenamed) == kind(x)) call abort ()
68
    if (kind(yrenamed) == kind(y)) call abort ()
69
  end subroutine
70
 
71
  subroutine test2  ! Test the fix applies to generic interfaces
72
    USE xmod
73
    USE xmod, ONLY: xfoobar_renamed => xfoobar
74
    USE ymod, ONLY: yfoobar_renamed => yfoobar
75
    USE ymod
76
    if (xfoobar_renamed (42) == xfoobar ()) call abort ()
77
    if (yfoobar_renamed (42) == yfoobar ()) call abort ()
78
  end subroutine
79
 
80
  subroutine test3  ! Check that USE_NAME == LOCAL_NAME is OK
81
    USE xmod
82
    USE xmod, ONLY: x => x, xfoobar => xfoobar
83
    USE ymod, ONLY: y => y, yfoobar => yfoobar
84
    USE ymod
85
    if (kind (x) /= 4) call abort ()
86
    if (kind (y) /= 4) call abort ()
87
    if (xfoobar (77) /= 77_4) call abort ()
88
    if (yfoobar (77) /= 77_4) call abort ()
89
  end subroutine
90
END PROGRAM test2uses
91
! { dg-final { cleanup-modules "xmod ymod" } }

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.