for (const auto &pair : scope) {
Check(*pair.second);
}
+ int mainProgCnt{0};
for (const Scope &child : scope.children()) {
Check(child);
+ // A program shall consist of exactly one main program (5.2.2).
+ if (child.kind() == Scope::Kind::MainProgram) {
+ ++mainProgCnt;
+ if (mainProgCnt > 1) {
+ messages_.Say(child.sourceRange(),
+ "A source file cannot contain more than one main program"_err_en_US);
+ }
+ }
}
if (scope.kind() == Scope::Kind::BlockData) {
CheckBlockData(scope);
return *symbol;
} else {
if (!CheckPossibleBadForwardRef(*symbol)) {
+ if (name.empty() && symbol->name().empty()) {
+ // report the error elsewhere
+ return *symbol;
+ }
SayAlreadyDeclared(name, *symbol);
}
// replace the old symbol with a new one with correct details
end
end
-program p04
+subroutine p04
implicit none
!ERROR: No explicit type declared for 'index'
call s1(index)
end program
-program test_overlap
+subroutine test_overlap
integer :: i
!OK: these cases do not overlap
select case(i)
end select
end
-program test_overflow
+subroutine test_overflow
integer :: j
select case(1_1)
case (127)
!ERROR: 'a' is use-associated from module 'm2' and cannot be re-declared
integer :: a = 2
end
-program testUse2
+subroutine testUse2
use m1,only : a ! This forces the use association of m1's "a" as local "a"
use m1,z=>a ! This rename doesn't affect the previous forced USE association
!ERROR: 'a' is use-associated from module 'm1' and cannot be re-declared
integer :: a = 2
end
-program testUse3
+subroutine testUse3
use m1 ! By itself, this would use associate m1's "a" with a local "a"
use m1,z=>a ! This rename of m1'a "a" removes the previous use association
integer :: a = 2
end
-program testUse4
+subroutine testUse4
use m1,only : a ! Use associate m1's "a" with local "a"
use m1,z=>a ! Also use associate m1's "a" with local "z", also pulls in "b"
!ERROR: 'b' is use-associated from module 'm1' and cannot be re-declared
integer :: b = 2
end
-program testUse5
+subroutine testUse5
use m1,z=>a ! The rename prevents creation of a local "a"
use m1 ! Does not create a local "a" because of the previous rename
integer :: a = 2
end
-program testUse6
+subroutine testUse6
use m1, z => a ! Hides m1's "a"
use m1, y => b ! Hides m1's "b"
integer :: a = 4 ! OK
integer :: b = 5 ! OK
end
-program testUse7
+subroutine testUse7
use m3,t1=>t2,t2=>t1 ! Looks weird but all is good
type(t1) x
type(t2) y
x%t2_value = a
y%t1_value = z
end
-program testUse8
+subroutine testUse8
use m4 ! This USE associates all of m1
!ERROR: 'a' is use-associated from module 'm4' and cannot be re-declared
integer :: a = 2
end
-program testUse9
+subroutine testUse9
use m5
integer :: a = 2
end
-program testUse10
+subroutine testUse10
use m4
use m4, z=>a ! This rename erases the USE assocated "a" from m1
integer :: a = 2
end
-program testUse11
+subroutine testUse11
use m6
use m6, z=>a ! This rename erases the USE assocated "a" from m1
integer :: a = 2
end
-program testUse12
+subroutine testUse12
use m4 ! This USE associates "a" from m1
use m1, z=>a ! This renames the "a" from m1, but not the one through m4
!ERROR: 'a' is use-associated from module 'm4' and cannot be re-declared
--- /dev/null
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test the restriction in 5.2.2
+
+end
+!ERROR: A source file cannot contain more than one main program
+end
--- /dev/null
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test the restriction in 5.2.2
+
+program m
+end
+!ERROR: A source file cannot contain more than one main program
+end
--- /dev/null
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test the restriction in 5.2.2
+
+end
+!ERROR: A source file cannot contain more than one main program
+program m
+end
--- /dev/null
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test the restriction in 5.2.2
+
+program m
+end
+!ERROR: A source file cannot contain more than one main program
+!ERROR: 'm' is already declared in this scoping unit
+program m
+end
--- /dev/null
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test the restriction in 5.2.2
+
+program m
+end
+!ERROR: A source file cannot contain more than one main program
+program m2
+end
--- /dev/null
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Test the restriction in 5.2.2
+
+end
+!ERROR: A source file cannot contain more than one main program
+end
+!ERROR: A source file cannot contain more than one main program
+end
! The loop iteration variable may not appear in a threadprivate directive.
-program omp_do
+subroutine omp_do
integer, save:: i, j, k,n
!$omp threadprivate(k,j,i)
!$omp do collapse(2)
end do
end do
!$omp end do
-end program omp_do
+end subroutine omp_do
-program omp_do1
+subroutine omp_do1
+ integer, save :: i, j, k
!$omp threadprivate(k,j,i)
!$omp do
!ERROR: Loop iteration variable i is not allowed in THREADPRIVATE.
end do
!$omp end do
-end program omp_do1
+end subroutine omp_do1
-program omp_do2
+subroutine omp_do2
+ integer, save :: k, j
!$omp threadprivate(k)
!$omp threadprivate(j)
call compute()
!$omp end do
end subroutine
-end program omp_do2
+end subroutine omp_do2
-program omp_do3
+subroutine omp_do3
+ integer, save :: i
!$omp threadprivate(i)
!$omp parallel
print *, "parallel"
end do
!$omp end do
-end program omp_do3
+end subroutine omp_do3
module tp
!integer i,j
use tp
end module usetp
-program main
+subroutine main
use usetp
!$omp do
!ERROR: Loop iteration variable i is not allowed in THREADPRIVATE.
end do
end do
!$omp end do
-end program
+end subroutine
-program main1
+subroutine main1
use tp
!$omp do
!ERROR: Loop iteration variable j is not allowed in THREADPRIVATE.
end do
end do
!$omp end do
-end program
+end subroutine
!$omp end do
end program omp_do
-!DEF: /omp_do2 MainProgram
-program omp_do2
+!DEF: /omp_do2 (Subroutine)Subprogram
+subroutine omp_do2
!DEF: /omp_do2/i ObjectEntity INTEGER(4)
!DEF: /omp_do2/k ObjectEntity INTEGER(4)
integer :: i = 0, k
print *, "it", i
end do
!$omp end do
-end program omp_do2
+end subroutine omp_do2
procedure(foo), pointer :: r
end function foo
-program iface
+subroutine iface
!ERROR: Procedure 'p' is recursively defined. Procedures in the cycle: 'p', 'sub', 'p2'
procedure(sub) :: p
interface
end subroutine
end interface
call p(sub)
-end program
+end subroutine
-Program mutual
+subroutine mutual
Procedure(sub1) :: p
Call p(sub)
Subroutine sub(p2)
Procedure(sub1) :: p2
End Subroutine
-End Program
+End subroutine
-Program mutual1
+subroutine mutual1
Procedure(sub1) :: p
Call p(sub)
Subroutine sub(p2)
Procedure(sub1) :: p2
End Subroutine
-End Program
+End subroutine
-program twoCycle
+subroutine twoCycle
!ERROR: The interface for procedure 'p1' is recursively defined
!ERROR: The interface for procedure 'p2' is recursively defined
procedure(p1) p2
procedure(p2) p1
call p1
call p2
-end program
+end subroutine
-program threeCycle
+subroutine threeCycle
!ERROR: The interface for procedure 'p1' is recursively defined
!ERROR: The interface for procedure 'p2' is recursively defined
procedure(p1) p2
call p1
call p2
call p3
-end program
+end subroutine
module mutualSpecExprs
contains
integer, parameter :: k2 = selected_int_kind(9)
end
-program p1
+subroutine p1
use m1
use m2
! check that selected_int_kind is not use-associated
! RUN: %python %S/test_errors.py %s %flang_fc1
! Test section subscript
-program p1
+subroutine p1
real :: a(10,10)
real :: b(5,5)
real :: c
end
! Test substring
-program p2
+subroutine p2
type t1(n1,n2)
integer,kind :: n1,n2
integer :: c2(iachar('ABCDEFGHIJ'(n1:n1)))
end
! Test pointer assignment with bounds
-program p3
+subroutine p3
integer, pointer :: a(:,:)
integer, target :: b(2,2)
integer :: n
end
! Test pointer assignment to array element
-program p4
+subroutine p4
type :: t
real, pointer :: a
end type
integer :: i
real, target :: y
x(i)%a => y
-end program
+end subroutine
! RUN: %python %S/test_errors.py %s %flang_fc1
-program p1
+subroutine p1
integer(8) :: a, b, c, d
pointer(a, b)
!ERROR: 'b' cannot be a Cray pointer as it is already a Cray pointee
pointer(d, a)
end
-program p2
+subroutine p2
pointer(a, c)
!ERROR: 'c' was already declared as a Cray pointee
pointer(b, c)
end
-program p3
+subroutine p3
real a
!ERROR: Cray pointer 'a' must have type INTEGER(8)
pointer(a, b)
end
-program p4
+subroutine p4
implicit none
real b
!ERROR: No explicit type declared for 'd'
pointer(a, b), (c, d)
end
-program p5
+subroutine p5
integer(8) a(10)
!ERROR: Cray pointer 'a' must be a scalar
pointer(a, b)
end
-program p6
+subroutine p6
real b(8)
!ERROR: Array spec was already declared for 'b'
pointer(a, b(4))
end
-program p7
+subroutine p7
!ERROR: Cray pointee 'b' must have must have explicit shape or assumed size
pointer(a, b(:))
contains
end
end
-program p8
+subroutine p8
integer(8), parameter :: k = 2
type t
end type
end
end
-program p9
+subroutine p9
integer(8), parameter :: k = 2
type t
end type
integer(8) :: a
real :: b
end
-program p10
+subroutine p10
use m10
!ERROR: 'b' cannot be a Cray pointee as it is use-associated
pointer(a, c),(d, b)
end
-program p11
+subroutine p11
pointer(a, b)
!ERROR: PARAMETER attribute not allowed on 'a'
parameter(a=2)
parameter(b=3)
end
-program p12
+subroutine p12
type t1
sequence
real c1
j = f(2)
end program
-!DEF: /p2 MainProgram
-program p2
+!DEF: /p2 (Subroutine)Subprogram
+subroutine p2
!DEF: /p2/f (Function, StmtFunction) Subprogram REAL(4)
!DEF: /p2/f/x (Implicit) ObjectEntity REAL(4)
!DEF: /p2/y (Implicit) ObjectEntity REAL(4)
f(x) = y
!REF: /p2/y
y = 1.0
-end program
+end subroutine