[flang-commits] [flang] 43a263f - [flang] Implement semantic checks for ELEMENTAL subprograms
peter klausler via flang-commits
flang-commits at lists.llvm.org
Tue Sep 7 14:38:01 PDT 2021
Author: peter klausler
Date: 2021-09-07T14:37:23-07:00
New Revision: 43a263f570dbe88524ab3689bc994df60c531310
URL: https://github.com/llvm/llvm-project/commit/43a263f570dbe88524ab3689bc994df60c531310
DIFF: https://github.com/llvm/llvm-project/commit/43a263f570dbe88524ab3689bc994df60c531310.diff
LOG: [flang] Implement semantic checks for ELEMENTAL subprograms
Adds missing semantic checks for ELEMENTAL functions and subroutines,
their dummy arguments, and their results from F'2018 15.8.1 C15100-15102.
Differential Revision: https://reviews.llvm.org/D109380
Added:
flang/test/Semantics/elemental01.f90
Modified:
flang/lib/Semantics/check-declarations.cpp
flang/test/Evaluate/folding28.f90
flang/test/Semantics/assign03.f90
flang/test/Semantics/associated.f90
flang/test/Semantics/final02.f90
flang/test/Semantics/resolve83.f90
flang/test/Semantics/typeinfo01.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 368c8a108a5b9..33a8b19690f6d 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -90,6 +90,9 @@ class CheckHelper {
bool InPure() const {
return innermostSymbol_ && IsPureProcedure(*innermostSymbol_);
}
+ bool InElemental() const {
+ return innermostSymbol_ && innermostSymbol_->attrs().test(Attr::ELEMENTAL);
+ }
bool InFunction() const {
return innermostSymbol_ && IsFunction(*innermostSymbol_);
}
@@ -526,6 +529,44 @@ void CheckHelper::CheckObjectEntity(
messages_.Say("OPTIONAL attribute may apply only to a dummy "
"argument"_err_en_US); // C849
}
+ if (InElemental()) {
+ if (details.isDummy()) { // C15100
+ if (details.shape().Rank() > 0) {
+ messages_.Say(
+ "A dummy argument of an ELEMENTAL procedure must be scalar"_err_en_US);
+ }
+ if (IsAllocatable(symbol)) {
+ messages_.Say(
+ "A dummy argument of an ELEMENTAL procedure may not be ALLOCATABLE"_err_en_US);
+ }
+ if (IsCoarray(symbol)) {
+ messages_.Say(
+ "A dummy argument of an ELEMENTAL procedure may not be a coarray"_err_en_US);
+ }
+ if (IsPointer(symbol)) {
+ messages_.Say(
+ "A dummy argument of an ELEMENTAL procedure may not be a POINTER"_err_en_US);
+ }
+ if (!symbol.attrs().HasAny(Attrs{Attr::VALUE, Attr::INTENT_IN,
+ Attr::INTENT_INOUT, Attr::INTENT_OUT})) { // C15102
+ messages_.Say(
+ "A dummy argument of an ELEMENTAL procedure must have an INTENT() or VALUE attribute"_err_en_US);
+ }
+ } else if (IsFunctionResult(symbol)) { // C15101
+ if (details.shape().Rank() > 0) {
+ messages_.Say(
+ "The result of an ELEMENTAL function must be scalar"_err_en_US);
+ }
+ if (IsAllocatable(symbol)) {
+ messages_.Say(
+ "The result of an ELEMENTAL function may not be ALLOCATABLE"_err_en_US);
+ }
+ if (IsPointer(symbol)) {
+ messages_.Say(
+ "The result of an ELEMENTAL function may not be a POINTER"_err_en_US);
+ }
+ }
+ }
if (HasDeclarationInitializer(symbol)) { // C808; ignore DATA initialization
CheckPointerInitialization(symbol);
if (IsAutomatic(symbol)) {
@@ -689,7 +730,10 @@ void CheckHelper::CheckProcEntity(
messages_.Say("A dummy procedure without the POINTER attribute"
" may not have an INTENT attribute"_err_en_US);
}
-
+ if (InElemental()) { // C15100
+ messages_.Say(
+ "An ELEMENTAL subprogram may not have a dummy procedure"_err_en_US);
+ }
const Symbol *interface { details.interface().symbol() };
if (!symbol.attrs().test(Attr::INTRINSIC) &&
(symbol.attrs().test(Attr::ELEMENTAL) ||
@@ -845,9 +889,21 @@ void CheckHelper::CheckSubprogram(
}
}
}
- // See comment on the similar check in CheckProcEntity()
- if (details.isDummy() && symbol.attrs().test(Attr::ELEMENTAL)) {
- messages_.Say("A dummy procedure may not be ELEMENTAL"_err_en_US);
+ if (symbol.attrs().test(Attr::ELEMENTAL)) {
+ // See comment on the similar check in CheckProcEntity()
+ if (details.isDummy()) {
+ messages_.Say("A dummy procedure may not be ELEMENTAL"_err_en_US);
+ } else if (details.dummyArgs().empty()) {
+ messages_.Say(
+ "An ELEMENTAL subprogram must have at least one dummy argument"_err_en_US);
+ } else {
+ for (const Symbol *dummy : details.dummyArgs()) {
+ if (!dummy) { // C15100
+ messages_.Say(
+ "An ELEMENTAL subroutine may not have an alternate return dummy argument"_err_en_US);
+ }
+ }
+ }
}
}
diff --git a/flang/test/Evaluate/folding28.f90 b/flang/test/Evaluate/folding28.f90
index 406fc06afd381..dcd9e4865d60a 100644
--- a/flang/test/Evaluate/folding28.f90
+++ b/flang/test/Evaluate/folding28.f90
@@ -1,5 +1,4 @@
-! RUN: %S/test_folding.sh %s %t %flang_fc1
-! REQUIRES: shell
+! RUN: %python %S/test_folding.py %s %flang_fc1
! Tests folding of SQRT()
module m
implicit none
diff --git a/flang/test/Semantics/assign03.f90 b/flang/test/Semantics/assign03.f90
index 8e502f31de9db..0c7260e8ff5b5 100644
--- a/flang/test/Semantics/assign03.f90
+++ b/flang/test/Semantics/assign03.f90
@@ -79,8 +79,9 @@ pure integer function f_pure()
integer function f_impure()
f_impure = 1
end
- elemental integer function f_elemental()
- f_elemental = 1
+ elemental integer function f_elemental(n)
+ real, value :: n
+ f_elemental = n
end
end
diff --git a/flang/test/Semantics/associated.f90 b/flang/test/Semantics/associated.f90
index 509aa2dd762dc..4d70a2014edf5 100644
--- a/flang/test/Semantics/associated.f90
+++ b/flang/test/Semantics/associated.f90
@@ -27,8 +27,9 @@ pure integer function pureFunc()
pureFunc = 343
end function pureFunc
- elemental integer function elementalFunc()
- elementalFunc = 343
+ elemental integer function elementalFunc(n)
+ integer, value :: n
+ elementalFunc = n
end function elementalFunc
subroutine subr(i)
diff --git a/flang/test/Semantics/elemental01.f90 b/flang/test/Semantics/elemental01.f90
new file mode 100644
index 0000000000000..24847760cd6eb
--- /dev/null
+++ b/flang/test/Semantics/elemental01.f90
@@ -0,0 +1,54 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Tests ELEMENTAL subprogram constraints C15100-15102
+
+!ERROR: An ELEMENTAL subprogram must have at least one dummy argument
+elemental integer function noargs
+ noargs = 1
+end function
+
+!ERROR: An ELEMENTAL subroutine may not have an alternate return dummy argument
+elemental subroutine altret(*)
+end subroutine
+
+elemental subroutine arrarg(a)
+ !ERROR: A dummy argument of an ELEMENTAL procedure must be scalar
+ real, intent(in) :: a(1)
+end subroutine
+
+elemental subroutine alloarg(a)
+ !ERROR: A dummy argument of an ELEMENTAL procedure may not be ALLOCATABLE
+ real, intent(in), allocatable :: a
+end subroutine
+
+elemental subroutine coarg(a)
+ !ERROR: A dummy argument of an ELEMENTAL procedure may not be a coarray
+ real, intent(in) :: a[*]
+end subroutine
+
+elemental subroutine ptrarg(a)
+ !ERROR: A dummy argument of an ELEMENTAL procedure may not be a POINTER
+ real, intent(in), pointer :: a
+end subroutine
+
+impure elemental subroutine barearg(a)
+ !ERROR: A dummy argument of an ELEMENTAL procedure must have an INTENT() or VALUE attribute
+ real :: a
+end subroutine
+
+elemental function arrf(n)
+ integer, value :: n
+ !ERROR: The result of an ELEMENTAL function must be scalar
+ real :: arrf(n)
+end function
+
+elemental function allof(n)
+ integer, value :: n
+ !ERROR: The result of an ELEMENTAL function may not be ALLOCATABLE
+ real, allocatable :: allof
+end function
+
+elemental function ptrf(n)
+ integer, value :: n
+ !ERROR: The result of an ELEMENTAL function may not be a POINTER
+ real, pointer :: ptrf
+end function
diff --git a/flang/test/Semantics/final02.f90 b/flang/test/Semantics/final02.f90
index 8de8973ea40ca..b474f45ee5c32 100644
--- a/flang/test/Semantics/final02.f90
+++ b/flang/test/Semantics/final02.f90
@@ -33,9 +33,9 @@ subroutine t1f1(x)
type(t1) :: x(:)
end subroutine
impure elemental subroutine t2fe(x)
- type(t2) :: x
+ type(t2), intent(in out) :: x
end subroutine
- impure elemental subroutine t3far(x)
+ subroutine t3far(x)
type(t3) :: x(..)
end subroutine
end module
diff --git a/flang/test/Semantics/resolve83.f90 b/flang/test/Semantics/resolve83.f90
index fc18f28415214..e9d53dd6bd81d 100644
--- a/flang/test/Semantics/resolve83.f90
+++ b/flang/test/Semantics/resolve83.f90
@@ -28,7 +28,9 @@ real pure real function realFunc()
end function realFunc
!WARNING: Attribute 'ELEMENTAL' cannot be used more than once
- elemental real elemental function elementalFunc()
+ elemental real elemental function elementalFunc(x)
+ real, value :: x
+ elementalFunc = x
end function elementalFunc
!WARNING: Attribute 'IMPURE' cannot be used more than once
diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90
index 7c374bc0d5bcb..d911bd42cd376 100644
--- a/flang/test/Semantics/typeinfo01.f90
+++ b/flang/test/Semantics/typeinfo01.f90
@@ -121,7 +121,7 @@ subroutine s2(x)
type(t) :: x(3,3)
end subroutine
impure elemental subroutine s3(x)
- type(t) :: x
+ type(t), intent(in) :: x
end subroutine
!CHECK: .dt.t, SAVE, TARGET (CompilerCreated): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=3200_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1,nofinalizationneeded=0_1)
!CHECK: .s.t, SAVE, TARGET (CompilerCreated): ObjectEntity type: TYPE(specialbinding) shape: 0_8:2_8 init:[specialbinding::specialbinding(which=7_1,isargdescriptorset=0_1,proc=s3),specialbinding(which=10_1,isargdescriptorset=1_1,proc=s1),specialbinding(which=11_1,isargdescriptorset=0_1,proc=s2)]
More information about the flang-commits
mailing list