gcc/testsuite/gfortran.dg/global_references_1.f90

   1 ! { dg-do compile }
   2 ! This program tests the patch for PRs 20881, 23308, 25538 & 25710
   3 ! Assembled from PRs by Paul Thomas  <pault@gcc.gnu.org>
   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" } }