[flang-commits] [flang] 9299bde - [flang] Relax ALLOCATABLE/POINTER actual argument checks under INTENT(IN)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Fri Jun 2 08:06:31 PDT 2023
Author: Peter Klausler
Date: 2023-06-02T08:06:20-07:00
New Revision: 9299bde9e3797db3e46938eb7a53191826fb19c1
URL: https://github.com/llvm/llvm-project/commit/9299bde9e3797db3e46938eb7a53191826fb19c1
DIFF: https://github.com/llvm/llvm-project/commit/9299bde9e3797db3e46938eb7a53191826fb19c1.diff
LOG: [flang] Relax ALLOCATABLE/POINTER actual argument checks under INTENT(IN)
Per 15.5.2.5 p2, when both a dummy data object and its associated
actual argument are ALLOCATABLE or POINTER, there are rules requiring
that both be unlimited polymorphic if either is, and that both be
polymorphic if either is. The justifications for the first restriction
is that the called procedure might change the type of an unlimited
polymorphic dummy argument, but as this cannot occur for a dummy
argument with INTENT(IN), we can relax the check to an optional
portability warning. The justification for the second restriction
is that some implementations would have to create a type descriptor
to associate a monomorphic allocatable/pointer actual argument with
a polymorphic dummy argument, and that doesn't apply to f18 since we
use descriptors for them anyways.
Relaxing these needless checks allows more library procedures to
use "class(*), dimension(..), pointer, intent(in)" dummy arguments
in explicit interfaces.
Differential Revision: https://reviews.llvm.org/D151941
Added:
flang/test/Semantics/call36.f90
Modified:
flang/include/flang/Common/Fortran-features.h
flang/lib/Semantics/check-call.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 8466c86dfff7e..1af049c7f4e61 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -36,7 +36,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
ForwardRefImplicitNone, OpenAccessAppend, BOZAsDefaultInteger,
DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat,
SaveMainProgram, SaveBigMainProgramVariables,
- DistinctArrayConstructorLengths, PPCVector)
+ DistinctArrayConstructorLengths, PPCVector, RelaxedIntentInChecking)
// Portability and suspicious usage warnings for conforming code
ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index e5a338b64bf68..57ddc3fde58df 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -526,30 +526,49 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
// 15.5.2.5 -- actual & dummy are both POINTER or both ALLOCATABLE
- if ((actualIsPointer && dummyIsPointer) ||
+ // For INTENT(IN) we relax two checks that are in Fortran to
+ // prevent the callee from changing the type or to avoid having
+ // to use a descriptor.
+ if (!typesCompatible) {
+ // Don't pile on the errors emitted above
+ } else if ((actualIsPointer && dummyIsPointer) ||
(actualIsAllocatable && dummyIsAllocatable)) {
bool actualIsUnlimited{actualType.type().IsUnlimitedPolymorphic()};
bool dummyIsUnlimited{dummy.type.type().IsUnlimitedPolymorphic()};
if (actualIsUnlimited != dummyIsUnlimited) {
- if (typesCompatible) {
+ if (dummyIsUnlimited && dummy.intent == common::Intent::In &&
+ context.IsEnabled(common::LanguageFeature::RelaxedIntentInChecking)) {
+ if (context.ShouldWarn(
+ common::LanguageFeature::RelaxedIntentInChecking)) {
+ messages.Say(
+ "If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both should be so"_port_en_US);
+ }
+ } else {
messages.Say(
"If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so"_err_en_US);
}
} else if (dummyIsPolymorphic != actualIsPolymorphic) {
- if (dummy.intent == common::Intent::In && typesCompatible) {
- // extension: allow with warning, rule is only relevant for definables
- messages.Say(
- "If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both should be so"_port_en_US);
+ if (dummyIsPolymorphic && dummy.intent == common::Intent::In &&
+ context.IsEnabled(common::LanguageFeature::RelaxedIntentInChecking)) {
+ if (context.ShouldWarn(
+ common::LanguageFeature::RelaxedIntentInChecking)) {
+ messages.Say(
+ "If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both should be so"_port_en_US);
+ }
} else {
messages.Say(
"If a POINTER or ALLOCATABLE dummy or actual argument is polymorphic, both must be so"_err_en_US);
}
- } else if (!actualIsUnlimited && typesCompatible) {
+ } else if (!actualIsUnlimited) {
if (!actualType.type().IsTkCompatibleWith(dummy.type.type())) {
- if (dummy.intent == common::Intent::In) {
- // extension: allow with warning, rule is only relevant for definables
- messages.Say(
- "POINTER or ALLOCATABLE dummy and actual arguments should have the same declared type and kind"_port_en_US);
+ if (dummy.intent == common::Intent::In &&
+ context.IsEnabled(
+ common::LanguageFeature::RelaxedIntentInChecking)) {
+ if (context.ShouldWarn(
+ common::LanguageFeature::RelaxedIntentInChecking)) {
+ messages.Say(
+ "POINTER or ALLOCATABLE dummy and actual arguments should have the same declared type and kind"_port_en_US);
+ }
} else {
messages.Say(
"POINTER or ALLOCATABLE dummy and actual arguments must have the same declared type and kind"_err_en_US);
diff --git a/flang/test/Semantics/call36.f90 b/flang/test/Semantics/call36.f90
new file mode 100644
index 0000000000000..779aafdd2340a
--- /dev/null
+++ b/flang/test/Semantics/call36.f90
@@ -0,0 +1,25 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+! Test the RelaxedIntentInChecking extension
+module m
+ contains
+ subroutine intentInUnlimited(x)
+ class(*), dimension(..), pointer, intent(in) :: x
+ end
+ subroutine intentInOutUnlimited(x)
+ class(*), dimension(..), pointer, intent(in out) :: x
+ end
+ subroutine test
+ integer, target :: scalar
+ real, pointer :: arrayptr(:)
+ class(*), pointer :: unlimited(:)
+ call intentInUnlimited(scalar)
+ !ERROR: Actual argument associated with POINTER dummy argument 'x=' must also be POINTER unless INTENT(IN)
+ call intentInOutUnlimited(scalar)
+ !PORTABILITY: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both should be so
+ call intentInUnlimited(arrayptr)
+ !ERROR: If a POINTER or ALLOCATABLE dummy or actual argument is unlimited polymorphic, both must be so
+ call intentInOutUnlimited(arrayptr)
+ call intentInUnlimited(unlimited) ! ok
+ call intentInOutUnlimited(unlimited) ! ok
+ end
+end
More information about the flang-commits
mailing list