[flang-commits] [flang] c207e36 - [flang] Enforce a program not including more than one main program
via flang-commits
flang-commits at lists.llvm.org
Sun May 8 19:50:18 PDT 2022
Author: Peixin-Qiao
Date: 2022-05-09T10:48:06+08:00
New Revision: c207e36025f7a7889f1f26cf8a1b797656060e78
URL: https://github.com/llvm/llvm-project/commit/c207e36025f7a7889f1f26cf8a1b797656060e78
DIFF: https://github.com/llvm/llvm-project/commit/c207e36025f7a7889f1f26cf8a1b797656060e78.diff
LOG: [flang] Enforce a program not including more than one main program
As Fortran 2018 5.2.2 states, a program shall consist of exactly one
main program. Add this semantic check.
Reviewed By: klausler
Differential Revision: https://reviews.llvm.org/D125186
Added:
flang/test/Semantics/multi-programs01.f90
flang/test/Semantics/multi-programs02.f90
flang/test/Semantics/multi-programs03.f90
flang/test/Semantics/multi-programs04.f90
flang/test/Semantics/multi-programs05.f90
flang/test/Semantics/multi-programs06.f90
Modified:
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/call02.f90
flang/test/Semantics/case01.f90
flang/test/Semantics/modfile41.f90
flang/test/Semantics/omp-do04.f90
flang/test/Semantics/omp-do11.f90
flang/test/Semantics/resolve102.f90
flang/test/Semantics/resolve14.f90
flang/test/Semantics/resolve49.f90
flang/test/Semantics/resolve61.f90
flang/test/Semantics/symbol16.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 7ee267bd2a876..42fa416f49af8 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -1711,8 +1711,17 @@ void CheckHelper::Check(const Scope &scope) {
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);
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index fd1b0a05c65cc..076e0bff4aea0 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -612,6 +612,10 @@ class ScopeHandler : public ImplicitRulesVisitor {
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
diff --git a/flang/test/Semantics/call02.f90 b/flang/test/Semantics/call02.f90
index 8be2f41ccb1d6..dfd1ba5537d46 100644
--- a/flang/test/Semantics/call02.f90
+++ b/flang/test/Semantics/call02.f90
@@ -110,7 +110,7 @@ subroutine s3(p)
end
end
-program p04
+subroutine p04
implicit none
!ERROR: No explicit type declared for 'index'
call s1(index)
diff --git a/flang/test/Semantics/case01.f90 b/flang/test/Semantics/case01.f90
index 7e2d1efa34585..147f8d89b1161 100644
--- a/flang/test/Semantics/case01.f90
+++ b/flang/test/Semantics/case01.f90
@@ -164,7 +164,7 @@ program selectCaseProg
end program
-program test_overlap
+subroutine test_overlap
integer :: i
!OK: these cases do not overlap
select case(i)
@@ -178,7 +178,7 @@ program test_overlap
end select
end
-program test_overflow
+subroutine test_overflow
integer :: j
select case(1_1)
case (127)
diff --git a/flang/test/Semantics/modfile41.f90 b/flang/test/Semantics/modfile41.f90
index caba833e8d32a..cc6c31490e80d 100644
--- a/flang/test/Semantics/modfile41.f90
+++ b/flang/test/Semantics/modfile41.f90
@@ -34,61 +34,61 @@ program testUse1
!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
diff --git a/flang/test/Semantics/multi-programs01.f90 b/flang/test/Semantics/multi-programs01.f90
new file mode 100644
index 0000000000000..43270f4ac3507
--- /dev/null
+++ b/flang/test/Semantics/multi-programs01.f90
@@ -0,0 +1,6 @@
+! 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
diff --git a/flang/test/Semantics/multi-programs02.f90 b/flang/test/Semantics/multi-programs02.f90
new file mode 100644
index 0000000000000..33ac83312215a
--- /dev/null
+++ b/flang/test/Semantics/multi-programs02.f90
@@ -0,0 +1,7 @@
+! 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
diff --git a/flang/test/Semantics/multi-programs03.f90 b/flang/test/Semantics/multi-programs03.f90
new file mode 100644
index 0000000000000..62385b8e2f906
--- /dev/null
+++ b/flang/test/Semantics/multi-programs03.f90
@@ -0,0 +1,7 @@
+! 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
diff --git a/flang/test/Semantics/multi-programs04.f90 b/flang/test/Semantics/multi-programs04.f90
new file mode 100644
index 0000000000000..54b0235aa78f0
--- /dev/null
+++ b/flang/test/Semantics/multi-programs04.f90
@@ -0,0 +1,9 @@
+! 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
diff --git a/flang/test/Semantics/multi-programs05.f90 b/flang/test/Semantics/multi-programs05.f90
new file mode 100644
index 0000000000000..8ef061ed1e2e5
--- /dev/null
+++ b/flang/test/Semantics/multi-programs05.f90
@@ -0,0 +1,8 @@
+! 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
diff --git a/flang/test/Semantics/multi-programs06.f90 b/flang/test/Semantics/multi-programs06.f90
new file mode 100644
index 0000000000000..ec7d12e93ad0f
--- /dev/null
+++ b/flang/test/Semantics/multi-programs06.f90
@@ -0,0 +1,8 @@
+! 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
diff --git a/flang/test/Semantics/omp-do04.f90 b/flang/test/Semantics/omp-do04.f90
index 3ef7e7fb49525..8d327b4031c8d 100644
--- a/flang/test/Semantics/omp-do04.f90
+++ b/flang/test/Semantics/omp-do04.f90
@@ -4,7 +4,7 @@
! 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)
@@ -16,9 +16,10 @@ program omp_do
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.
@@ -29,9 +30,10 @@ program omp_do1
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()
@@ -47,9 +49,10 @@ subroutine 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"
@@ -63,7 +66,7 @@ program omp_do3
end do
!$omp end do
-end program omp_do3
+end subroutine omp_do3
module tp
!integer i,j
@@ -76,7 +79,7 @@ module usetp
use tp
end module usetp
-program main
+subroutine main
use usetp
!$omp do
!ERROR: Loop iteration variable i is not allowed in THREADPRIVATE.
@@ -86,9 +89,9 @@ program main
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.
@@ -98,4 +101,4 @@ program main1
end do
end do
!$omp end do
-end program
+end subroutine
diff --git a/flang/test/Semantics/omp-do11.f90 b/flang/test/Semantics/omp-do11.f90
index c12eb1cee4715..e9269939856b7 100644
--- a/flang/test/Semantics/omp-do11.f90
+++ b/flang/test/Semantics/omp-do11.f90
@@ -21,8 +21,8 @@ program omp_do
!$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
@@ -33,4 +33,4 @@ program omp_do2
print *, "it", i
end do
!$omp end do
-end program omp_do2
+end subroutine omp_do2
diff --git a/flang/test/Semantics/resolve102.f90 b/flang/test/Semantics/resolve102.f90
index ef6a477032a1d..8d34d17ae7762 100644
--- a/flang/test/Semantics/resolve102.f90
+++ b/flang/test/Semantics/resolve102.f90
@@ -26,7 +26,7 @@ function foo() result(r)
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
@@ -36,9 +36,9 @@ subroutine sub(p2)
end subroutine
end interface
call p(sub)
-end program
+end subroutine
-Program mutual
+subroutine mutual
Procedure(sub1) :: p
Call p(sub)
@@ -52,9 +52,9 @@ Subroutine sub1(arg)
Subroutine sub(p2)
Procedure(sub1) :: p2
End Subroutine
-End Program
+End subroutine
-Program mutual1
+subroutine mutual1
Procedure(sub1) :: p
Call p(sub)
@@ -68,18 +68,18 @@ Subroutine sub1(arg)
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
@@ -89,7 +89,7 @@ program threeCycle
call p1
call p2
call p3
-end program
+end subroutine
module mutualSpecExprs
contains
diff --git a/flang/test/Semantics/resolve14.f90 b/flang/test/Semantics/resolve14.f90
index 67cb5b2ab30fe..78b80ae8de935 100644
--- a/flang/test/Semantics/resolve14.f90
+++ b/flang/test/Semantics/resolve14.f90
@@ -12,7 +12,7 @@ module m2
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
diff --git a/flang/test/Semantics/resolve49.f90 b/flang/test/Semantics/resolve49.f90
index 8a6a09b0d3848..aa6d76e2298a5 100644
--- a/flang/test/Semantics/resolve49.f90
+++ b/flang/test/Semantics/resolve49.f90
@@ -1,6 +1,6 @@
! 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
@@ -10,7 +10,7 @@ program p1
end
! Test substring
-program p2
+subroutine p2
type t1(n1,n2)
integer,kind :: n1,n2
integer :: c2(iachar('ABCDEFGHIJ'(n1:n1)))
@@ -31,7 +31,7 @@ program p2
end
! Test pointer assignment with bounds
-program p3
+subroutine p3
integer, pointer :: a(:,:)
integer, target :: b(2,2)
integer :: n
@@ -41,7 +41,7 @@ program p3
end
! Test pointer assignment to array element
-program p4
+subroutine p4
type :: t
real, pointer :: a
end type
@@ -49,4 +49,4 @@ program p4
integer :: i
real, target :: y
x(i)%a => y
-end program
+end subroutine
diff --git a/flang/test/Semantics/resolve61.f90 b/flang/test/Semantics/resolve61.f90
index 7fa79987ab109..5223614b21702 100644
--- a/flang/test/Semantics/resolve61.f90
+++ b/flang/test/Semantics/resolve61.f90
@@ -1,5 +1,5 @@
! 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
@@ -8,38 +8,38 @@ program p1
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
@@ -51,7 +51,7 @@ subroutine s(x, y)
end
end
-program p8
+subroutine p8
integer(8), parameter :: k = 2
type t
end type
@@ -66,7 +66,7 @@ subroutine s
end
end
-program p9
+subroutine p9
integer(8), parameter :: k = 2
type t
end type
@@ -85,13 +85,13 @@ module m10
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)
@@ -99,7 +99,7 @@ program p11
parameter(b=3)
end
-program p12
+subroutine p12
type t1
sequence
real c1
diff --git a/flang/test/Semantics/symbol16.f90 b/flang/test/Semantics/symbol16.f90
index b710bc6901979..7a46092c36b53 100644
--- a/flang/test/Semantics/symbol16.f90
+++ b/flang/test/Semantics/symbol16.f90
@@ -16,12 +16,12 @@ program p1
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
More information about the flang-commits
mailing list