[flang-commits] [flang] 452d7eb - [flang] Ensure that intrinsic procedures are PURE &/or ELEMENTAL
peter klausler via flang-commits
flang-commits at lists.llvm.org
Wed Feb 17 11:31:43 PST 2021
Author: peter klausler
Date: 2021-02-17T11:31:33-08:00
New Revision: 452d7ebc093a5f1434d2c616beb4a9fac6dc9783
URL: https://github.com/llvm/llvm-project/commit/452d7ebc093a5f1434d2c616beb4a9fac6dc9783
DIFF: https://github.com/llvm/llvm-project/commit/452d7ebc093a5f1434d2c616beb4a9fac6dc9783.diff
LOG: [flang] Ensure that intrinsic procedures are PURE &/or ELEMENTAL
The intrinsic procedure table properly classify the various
intrinsics, but the PURE and ELEMENTAL attributes that these
classifications imply don't always make it to the utility
predicates that test symbols for them, leading to spurious
error messages in some contexts. So set those attribute flags
as appropriate in name resolution, using a new function to
isolate the tests.
An alternate solution, in which the predicates would query
the intrinsic procedure table for these attributes on demand,
was something I also tried, so that this information could
come directly from an authoritative source; but it would have
required references to the intrinsic table to be passed along
on too many seemingly unrelated APIs and ended up looking messy.
Several symbol table tests needed to have their expected outputs
augmented with the PURE and ELEMENTAL flags. Some bogus messages
that were flagged as such in test/Semantics/doconcurrent01.f90 were
removed, since they are now correctly not emitted.
Differential Revision: https://reviews.llvm.org/D96878
Added:
Modified:
flang/lib/Semantics/resolve-names.cpp
flang/test/Semantics/call11.f90
flang/test/Semantics/doconcurrent01.f90
flang/test/Semantics/omp-symbol08.f90
flang/test/Semantics/procinterface01.f90
flang/test/Semantics/symbol13.f90
flang/test/Semantics/symbol14.f90
flang/test/Semantics/symbol15.f90
flang/test/Semantics/symbol17.f90
flang/test/Semantics/symbol18.f90
flang/test/Semantics/symbol19.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 7e122db3150f..b87916d39a4c 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -584,6 +584,7 @@ class ScopeHandler : public ImplicitRulesVisitor {
protected:
// Apply the implicit type rules to this symbol.
void ApplyImplicitRules(Symbol &);
+ void AcquireIntrinsicProcedureFlags(Symbol &);
const DeclTypeSpec *GetImplicitType(Symbol &, const Scope &);
bool ConvertToObjectEntity(Symbol &);
bool ConvertToProcEntity(Symbol &);
@@ -2146,7 +2147,7 @@ void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
}
if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) {
// type will be determined in expression semantics
- symbol.attrs().set(Attr::INTRINSIC);
+ AcquireIntrinsicProcedureFlags(symbol);
return;
}
}
@@ -2157,6 +2158,24 @@ void ScopeHandler::ApplyImplicitRules(Symbol &symbol) {
}
}
+// Ensure that the symbol for an intrinsic procedure is marked with
+// the INTRINSIC attribute. Also set PURE &/or ELEMENTAL as
+// appropriate.
+void ScopeHandler::AcquireIntrinsicProcedureFlags(Symbol &symbol) {
+ symbol.attrs().set(Attr::INTRINSIC);
+ switch (context().intrinsics().GetIntrinsicClass(symbol.name().ToString())) {
+ case evaluate::IntrinsicClass::elementalFunction:
+ case evaluate::IntrinsicClass::elementalSubroutine:
+ symbol.attrs().set(Attr::ELEMENTAL);
+ symbol.attrs().set(Attr::PURE);
+ break;
+ case evaluate::IntrinsicClass::impureSubroutine:
+ break;
+ default:
+ symbol.attrs().set(Attr::PURE);
+ }
+}
+
const DeclTypeSpec *ScopeHandler::GetImplicitType(
Symbol &symbol, const Scope &scope) {
const auto *type{implicitRulesMap_->at(&scope).GetType(symbol.name())};
@@ -3461,14 +3480,14 @@ bool DeclarationVisitor::Pre(const parser::IntentStmt &x) {
bool DeclarationVisitor::Pre(const parser::IntrinsicStmt &x) {
HandleAttributeStmt(Attr::INTRINSIC, x.v);
for (const auto &name : x.v) {
- auto *symbol{FindSymbol(name)};
- if (!ConvertToProcEntity(*symbol)) {
+ auto &symbol{DEREF(FindSymbol(name))};
+ if (!ConvertToProcEntity(symbol)) {
SayWithDecl(
- name, *symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);
- } else if (symbol->attrs().test(Attr::EXTERNAL)) { // C840
- Say(symbol->name(),
+ name, symbol, "INTRINSIC attribute not allowed on '%s'"_err_en_US);
+ } else if (symbol.attrs().test(Attr::EXTERNAL)) { // C840
+ Say(symbol.name(),
"Symbol '%s' cannot have both EXTERNAL and INTRINSIC attributes"_err_en_US,
- symbol->name());
+ symbol.name());
}
}
return false;
@@ -4692,10 +4711,14 @@ bool DeclarationVisitor::HandleUnrestrictedSpecificIntrinsicFunction(
// are acceptable as procedure interfaces.
Symbol &symbol{
MakeSymbol(InclusiveScope(), name.source, Attrs{Attr::INTRINSIC})};
+ symbol.set_details(ProcEntityDetails{});
+ symbol.set(Symbol::Flag::Function);
if (interface->IsElemental()) {
symbol.attrs().set(Attr::ELEMENTAL);
}
- symbol.set_details(ProcEntityDetails{});
+ if (interface->IsPure()) {
+ symbol.attrs().set(Attr::PURE);
+ }
Resolve(name, symbol);
return true;
} else {
@@ -5971,9 +5994,9 @@ void ResolveNamesVisitor::HandleProcedureName(
bool convertedToProcEntity{ConvertToProcEntity(*symbol)};
if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) &&
IsIntrinsic(symbol->name(), flag) && !IsDummy(*symbol)) {
- symbol->attrs().set(Attr::INTRINSIC);
// 8.2(3): ignore type from intrinsic in type-declaration-stmt
symbol->get<ProcEntityDetails>().set_interface(ProcInterface{});
+ AcquireIntrinsicProcedureFlags(*symbol);
}
if (!SetProcFlag(name, *symbol, flag)) {
return; // reported error
@@ -6058,9 +6081,14 @@ bool ResolveNamesVisitor::SetProcFlag(
if (flag == Symbol::Flag::Function) {
ApplyImplicitRules(symbol);
}
+ if (symbol.attrs().test(Attr::INTRINSIC)) {
+ AcquireIntrinsicProcedureFlags(symbol);
+ }
} else if (symbol.GetType() && flag == Symbol::Flag::Subroutine) {
SayWithDecl(
name, symbol, "Cannot call function '%s' like a subroutine"_err_en_US);
+ } else if (symbol.attrs().test(Attr::INTRINSIC)) {
+ AcquireIntrinsicProcedureFlags(symbol);
}
return true;
}
diff --git a/flang/test/Semantics/call11.f90 b/flang/test/Semantics/call11.f90
index 47e3df0164be..7919eec41e9f 100644
--- a/flang/test/Semantics/call11.f90
+++ b/flang/test/Semantics/call11.f90
@@ -80,4 +80,18 @@ subroutine test3
end forall
end subroutine
+ subroutine test4(ch)
+ type :: t
+ real, allocatable :: x
+ end type
+ type(t) :: a(1), b(1)
+ character(*), intent(in) :: ch
+ allocate (b(1)%x)
+ ! Intrinsic functions and a couple subroutines are pure; do not emit errors
+ do concurrent (j=1:1)
+ b(j)%x = cos(1.) + len(ch)
+ call move_alloc(from=b(j)%x, to=a(j)%x)
+ end do
+ end subroutine
+
end module
diff --git a/flang/test/Semantics/doconcurrent01.f90 b/flang/test/Semantics/doconcurrent01.f90
index c93206853393..ac1f43154939 100644
--- a/flang/test/Semantics/doconcurrent01.f90
+++ b/flang/test/Semantics/doconcurrent01.f90
@@ -164,28 +164,20 @@ subroutine s6()
end do
! Call to MOVE_ALLOC of a coarray outside a DO CONCURRENT. This is OK.
-call move_alloc(ca, cb)
-
-! Note that the errors below relating to MOVE_ALLOC() bing impure are bogus.
-! They're the result of the fact that access to the move_alloc() instrinsic
-! is not yet possible.
+ call move_alloc(ca, cb)
+! Call to MOVE_ALLOC with non-coarray arguments in a DO CONCURRENT. This is OK.
allocate(aa)
do concurrent (i = 1:10)
-!ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
call move_alloc(aa, ab)
end do
-! Call to MOVE_ALLOC with non-coarray arguments in a DO CONCURRENT. This is OK.
-
do concurrent (i = 1:10)
-!ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
call move_alloc(ca, cb)
end do
do concurrent (i = 1:10)
-!ERROR: Call to an impure procedure is not allowed in DO CONCURRENT
!ERROR: An image control statement is not allowed in DO CONCURRENT
call move_alloc(pvar%type1_field%coarray_type0_field, qvar%type1_field%coarray_type0_field)
end do
diff --git a/flang/test/Semantics/omp-symbol08.f90 b/flang/test/Semantics/omp-symbol08.f90
index 567c056b69e0..1fb2a866dd17 100644
--- a/flang/test/Semantics/omp-symbol08.f90
+++ b/flang/test/Semantics/omp-symbol08.f90
@@ -139,7 +139,7 @@ subroutine dotprod (b, c, n, block_size, num_teams, block_threads)
!$omp parallel do reduction(+:sum)
!DEF: /dotprod/Block1/Block1/Block1/Block1/i (OmpPrivate, OmpPreDetermined) HostAssoc INTEGER(4)
!REF: /dotprod/Block1/Block1/Block1/i0
- !DEF: /dotprod/min INTRINSIC (Function) ProcEntity
+ !DEF: /dotprod/min ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
!REF: /dotprod/block_size
!REF: /dotprod/n
do i=i0,min(i0+block_size, n)
diff --git a/flang/test/Semantics/procinterface01.f90 b/flang/test/Semantics/procinterface01.f90
index dd9fd3b66041..8f331682a028 100644
--- a/flang/test/Semantics/procinterface01.f90
+++ b/flang/test/Semantics/procinterface01.f90
@@ -53,13 +53,13 @@ end function tan
!DEF: /module1/derived1/p5 NOPASS, POINTER (Function) ProcEntity COMPLEX(4)
!DEF: /module1/nested4 PUBLIC (Function) Subprogram COMPLEX(4)
procedure(complex), pointer, nopass :: p5 => nested4
- !DEF: /module1/sin ELEMENTAL, INTRINSIC, PUBLIC ProcEntity
- !DEF: /module1/derived1/p6 NOPASS, POINTER ProcEntity
+ !DEF: /module1/sin ELEMENTAL, INTRINSIC, PUBLIC, PURE (Function) ProcEntity
+ !DEF: /module1/derived1/p6 NOPASS, POINTER (Function) ProcEntity
!REF: /module1/nested1
procedure(sin), pointer, nopass :: p6 => nested1
!REF: /module1/sin
- !DEF: /module1/derived1/p7 NOPASS, POINTER ProcEntity
- !DEF: /module1/cos ELEMENTAL, INTRINSIC, PUBLIC ProcEntity
+ !DEF: /module1/derived1/p7 NOPASS, POINTER (Function) ProcEntity
+ !DEF: /module1/cos ELEMENTAL, INTRINSIC, PUBLIC, PURE (Function) ProcEntity
procedure(sin), pointer, nopass :: p7 => cos
!REF: /module1/tan
!DEF: /module1/derived1/p8 NOPASS, POINTER (Function) ProcEntity CHARACTER(1_4,1)
@@ -105,7 +105,7 @@ complex function nested4(x)
!REF: /module1/nested4/x
real, intent(in) :: x
!DEF: /module1/nested4/nested4 ObjectEntity COMPLEX(4)
- !DEF: /module1/nested4/cmplx INTRINSIC (Function) ProcEntity
+ !DEF: /module1/nested4/cmplx ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
!REF: /module1/nested4/x
nested4 = cmplx(x+4., 6.)
end function nested4
diff --git a/flang/test/Semantics/symbol13.f90 b/flang/test/Semantics/symbol13.f90
index 47ea86b4b34a..6052bfcc4d1f 100644
--- a/flang/test/Semantics/symbol13.f90
+++ b/flang/test/Semantics/symbol13.f90
@@ -10,7 +10,7 @@
!REF: /f1/n
!REF: /f1/x1
!REF: /f1/x2
- !DEF: /f1/len INTRINSIC (Function) ProcEntity
+ !DEF: /f1/len ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
character*(n), intent(in) :: x1, x2*(len(x1)+1)
!DEF: /f1/t DerivedType
type :: t
diff --git a/flang/test/Semantics/symbol14.f90 b/flang/test/Semantics/symbol14.f90
index 5d1af5e6ed8c..7705bdbef1ca 100644
--- a/flang/test/Semantics/symbol14.f90
+++ b/flang/test/Semantics/symbol14.f90
@@ -17,7 +17,7 @@
!REF: /MainProgram1/t1/k
real :: b(k)
!DEF: /MainProgram1/t2/c ObjectEntity REAL(4)
- !DEF: /MainProgram1/size INTRINSIC (Function) ProcEntity
+ !DEF: /MainProgram1/size INTRINSIC, PURE (Function) ProcEntity
!REF: /MainProgram1/t1/a
real :: c(size(a))
!REF: /MainProgram1/t1
diff --git a/flang/test/Semantics/symbol15.f90 b/flang/test/Semantics/symbol15.f90
index cc230ff1fc03..7f307e72c2e5 100644
--- a/flang/test/Semantics/symbol15.f90
+++ b/flang/test/Semantics/symbol15.f90
@@ -12,7 +12,7 @@ subroutine iface
!DEF: /m/op1 POINTER, PUBLIC ObjectEntity REAL(4)
real, pointer :: op1
!DEF: /m/op2 POINTER, PUBLIC ObjectEntity REAL(4)
- !DEF: /m/null INTRINSIC, PUBLIC (Function) ProcEntity
+ !DEF: /m/null INTRINSIC, PUBLIC, PURE (Function) ProcEntity
real, pointer :: op2 => null()
!DEF: /m/op3 POINTER, PUBLIC ObjectEntity REAL(4)
!DEF: /m/x PUBLIC, TARGET ObjectEntity REAL(4)
diff --git a/flang/test/Semantics/symbol17.f90 b/flang/test/Semantics/symbol17.f90
index f453e2e6772b..d5b086b965e0 100644
--- a/flang/test/Semantics/symbol17.f90
+++ b/flang/test/Semantics/symbol17.f90
@@ -70,7 +70,7 @@ subroutine s1 (q1)
q1%n = 1
end subroutine
!DEF: /f2/fwdpdt DerivedType
-!DEF: /f2/kind INTRINSIC (Function) ProcEntity
+!DEF: /f2/kind INTRINSIC, PURE (Function) ProcEntity
!DEF: /f2 (Function) Subprogram TYPE(fwdpdt(k=4_4))
!DEF: /f2/n (Implicit) ObjectEntity INTEGER(4)
type(fwdpdt(kind(0))) function f2(n)
@@ -92,7 +92,7 @@ type(fwdpdt(kind(0))) function f2(n)
!DEF: /s2/q1 (Implicit) ObjectEntity TYPE(fwdpdt(k=4_4))
subroutine s2 (q1)
!DEF: /s2/fwdpdt DerivedType
- !DEF: /s2/kind INTRINSIC (Function) ProcEntity
+ !DEF: /s2/kind INTRINSIC, PURE (Function) ProcEntity
implicit type(fwdpdt(kind(0)))(q)
!REF: /s2/fwdpdt
!DEF: /s2/fwdpdt/k TypeParam INTEGER(4)
diff --git a/flang/test/Semantics/symbol18.f90 b/flang/test/Semantics/symbol18.f90
index 93987f6741ed..a0fa0eb7ff9f 100644
--- a/flang/test/Semantics/symbol18.f90
+++ b/flang/test/Semantics/symbol18.f90
@@ -4,14 +4,14 @@
!DEF: /p1 MainProgram
program p1
- !DEF: /p1/cos INTRINSIC (Function) ProcEntity
+ !DEF: /p1/cos ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
integer cos
!DEF: /p1/y (Implicit) ObjectEntity REAL(4)
!REF: /p1/cos
!DEF: /p1/x (Implicit) ObjectEntity REAL(4)
y = cos(x)
!REF: /p1/y
- !DEF: /p1/sin INTRINSIC (Function) ProcEntity
+ !DEF: /p1/sin ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
!REF: /p1/x
y = sin(x)
!REF: /p1/y
diff --git a/flang/test/Semantics/symbol19.f90 b/flang/test/Semantics/symbol19.f90
index 539edd1ed64e..94a6b8667673 100644
--- a/flang/test/Semantics/symbol19.f90
+++ b/flang/test/Semantics/symbol19.f90
@@ -18,7 +18,7 @@ subroutine expect_external
!DEF: /expect_intrinsic (Subroutine) Subprogram
subroutine expect_intrinsic
!DEF: /expect_intrinsic/y (Implicit) ObjectEntity REAL(4)
- !DEF: /expect_intrinsic/acos INTRINSIC (Function) ProcEntity
+ !DEF: /expect_intrinsic/acos ELEMENTAL, INTRINSIC, PURE (Function) ProcEntity
!DEF: /expect_intrinsic/x (Implicit) ObjectEntity REAL(4)
y = acos(x)
!DEF: /expect_intrinsic/system_clock INTRINSIC (Subroutine) ProcEntity
More information about the flang-commits
mailing list