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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [global_references_1.f90] - Blame information for rev 708

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn
! { dg-do compile }
2
! This program tests the patch for PRs 20881, 23308, 25538 & 25710
3
! Assembled from PRs by Paul Thomas  
4
module m
5
contains
6
  subroutine g(x)   ! Local entity
7
    REAL :: x
8
    x = 1.0
9
  end subroutine g
10
end module m
11
! Error only appears once but testsuite associates with both lines.
12
function f(x)       ! { dg-error "is already being used as a FUNCTION" }
13
  REAL :: f, x
14
  f = x
15
end function f
16
 
17
function g(x)       ! Global entity
18
  REAL :: g, x
19
  g = x
20
 
21
! PR25710==========================================================
22
! Lahey -2607-S: "SOURCE.F90", line 26:
23
! Function 'f' cannot be referenced as a subroutine. The previous
24
! definition is in 'line 12'.
25
 
26
  call f(g) ! { dg-error "is already being used as a FUNCTION" }
27
end function g
28
! Error only appears once but testsuite associates with both lines.
29
function h(x)       ! { dg-error "is already being used as a FUNCTION" }
30
  REAL :: h, x
31
  h = x
32
end function h
33
 
34
SUBROUTINE TT()
35
  CHARACTER(LEN=10), EXTERNAL :: j ! { dg-error "Return type mismatch" }
36
  CHARACTER(LEN=10)          :: T
37
! PR20881===========================================================
38
! Error only appears once but testsuite associates with both lines.
39
  T = j (1.0) ! { dg-error "is already being used as a SUBROUTINE" }
40
  print *, T
41
END SUBROUTINE TT
42
 
43
  use m             ! Main program
44
  real x
45
  integer a(10)
46
 
47
! PR23308===========================================================
48
! Lahey - 2604-S: "SOURCE.F90", line 52:
49
! The name 'foo' cannot be specified as both external procedure name
50
! and common block name. The previous appearance is in 'line 68'.
51
! Error only appears once but testsuite associates with both lines.
52
  common /foo/ a    ! { dg-error "is already being used as a COMMON" }
53
 
54
  call f (x)        ! OK - reference to local entity
55
  call g (x)        !             -ditto-
56
 
57
! PR25710===========================================================
58
! Lahey - 2607-S: "SOURCE.F90", line 62:
59
! Function 'h' cannot be referenced as a subroutine. The previous
60
! definition is in 'line 29'.
61
 
62
  call h (x) ! { dg-error "is already being used as a FUNCTION" }
63
 
64
! PR23308===========================================================
65
! Lahey - 2521-S: "SOURCE.F90", line 68: Intrinsic procedure name or
66
! external procedure name same as common block name 'foo'.
67
 
68
  call foo () ! { dg-error "is already being used as a COMMON" }
69
 
70
contains
71
  SUBROUTINE f (x)  ! Local entity
72
    real x
73
    x = 2
74
  end SUBROUTINE f
75
end
76
 
77
! PR20881===========================================================
78
! Lahey - 2636-S: "SOURCE.F90", line 81:
79
! Subroutine 'j' is previously referenced as a function in 'line 39'.
80
 
81
SUBROUTINE j (x)    ! { dg-error "is already being used as a SUBROUTINE" }
82
  integer a(10)
83
  common /bar/ a    ! Global entity foo
84
  real x
85
  x = bar(1.0)      ! OK for local procedure to have common block name
86
contains
87
  function bar (x)
88
    real bar, x
89
    bar = 2.0*x
90
  end function bar
91
END SUBROUTINE j
92
 
93
! PR25538===========================================================
94
! would ICE with entry and procedure having same names.
95
  subroutine link2 (namef) ! { dg-error "is already being used as a SUBROUTINE" }
96
    entry link2 (nameg)    ! { dg-error "is already being used as a SUBROUTINE" }
97
    return
98
  end
99
 
100
! { dg-final { cleanup-modules "m" } }

powered by: WebSVN 2.1.0

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