[flang-commits] [flang] edab721 - [flang] Implement IGNORE_TKR(P) (#165469)
via flang-commits
flang-commits at lists.llvm.org
Wed Oct 29 05:34:55 PDT 2025
Author: Eugene Epshteyn
Date: 2025-10-29T08:34:51-04:00
New Revision: edab7212c51016ef2338dd8b5439567a26fe7d25
URL: https://github.com/llvm/llvm-project/commit/edab7212c51016ef2338dd8b5439567a26fe7d25
DIFF: https://github.com/llvm/llvm-project/commit/edab7212c51016ef2338dd8b5439567a26fe7d25.diff
LOG: [flang] Implement IGNORE_TKR(P) (#165469)
Implemented IGNORE_TKR(P), which allows ignoring pointer and allocatable
matching (can pass an allocatable array to routine with pointer array
argument and vice versa). Updated documentation.
Added:
flang/test/Semantics/ignore_tkr04.f90
Modified:
flang/docs/Directives.md
flang/include/flang/Support/Fortran.h
flang/lib/Semantics/check-call.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/mod-file.cpp
flang/lib/Semantics/resolve-names.cpp
flang/lib/Support/Fortran.cpp
Removed:
################################################################################
diff --git a/flang/docs/Directives.md b/flang/docs/Directives.md
index 3ebb08c486228..2f16a8d579f8b 100644
--- a/flang/docs/Directives.md
+++ b/flang/docs/Directives.md
@@ -1,9 +1,9 @@
-<!--===- docs/Directives.md
-
+<!--===- docs/Directives.md
+
Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
See https://llvm.org/LICENSE.txt for license information.
SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
-
+
-->
# Compiler directives supported by Flang
@@ -12,16 +12,18 @@ A list of non-standard directives supported by Flang
* `!dir$ fixed` and `!dir$ free` select Fortran source forms. Their effect
persists to the end of the current source file.
-* `!dir$ ignore_tkr [[(TKRDMAC)] dummy-arg-name]...` in an interface definition
+* `!dir$ ignore_tkr [[(TKRDMACP)] dummy-arg-name]...` in an interface definition
disables some semantic checks at call sites for the actual arguments that
- correspond to some named dummy arguments (or all of them, by default).
- The directive allow actual arguments that would otherwise be diagnosed
- as incompatible in type (T), kind (K), rank (R), CUDA device (D), or
- managed (M) status. The letter (A) is a shorthand for all of these,
- and is the default when no letters appear. The letter (C) checks for
- contiguity for example allowing an element of an assumed-shape array to be
- passed as a dummy argument. For example, if one wanted to call a "set all
- bytes to zero" utility that could be applied to arrays of any type or rank:
+ correspond to some named dummy arguments (or all of them, by default). The
+ directive allow actual arguments that would otherwise be diagnosed as
+ incompatible in type (T), kind (K), rank (R), CUDA device (D), or managed (M)
+ status. The letter (A) is a shorthand for (TKRDM), and is the default when no
+ letters appear. The letter (C) checks for contiguity, for example allowing an
+ element of an assumed-shape array to be passed as a dummy argument. The
+ letter (P) ignores pointer and allocatable matching, so that one can pass an
+ allocatable array to routine with pointer array argument and vice versa. For
+ example, if one wanted to call a "set all bytes to zero" utility that could
+ be applied to arrays of any type or rank:
```
interface
subroutine clear(arr,bytes)
@@ -46,27 +48,27 @@ A list of non-standard directives supported by Flang
unroll the loop. Some compilers accept an optional `=` before the `n` when `n`
is present in the directive. Flang does not.
* `!dir$ unroll_and_jam [N]` control how many times a loop should be unrolled and
- jammed. It must be placed immediately before a loop that follows. `N` is an optional
- integer that specifying the unrolling factor. When `N` is `0` or `1`, the loop
+ jammed. It must be placed immediately before a loop that follows. `N` is an optional
+ integer that specifying the unrolling factor. When `N` is `0` or `1`, the loop
should not be unrolled at all. If `N` is omitted the optimizer will
selects the number of times to unroll the loop.
* `!dir$ novector` disabling vectorization on the following loop.
* `!dir$ nounroll` disabling unrolling on the following loop.
* `!dir$ nounroll_and_jam` disabling unrolling and jamming on the following loop.
-* `!dir$ inline` instructs the compiler to attempt to inline the called routines if the
- directive is specified before a call statement or all call statements within the loop
- body if specified before a DO LOOP or all function references if specified before an
+* `!dir$ inline` instructs the compiler to attempt to inline the called routines if the
+ directive is specified before a call statement or all call statements within the loop
+ body if specified before a DO LOOP or all function references if specified before an
assignment statement.
-* `!dir$ forceinline` works in the same way as the `inline` directive, but it forces
+* `!dir$ forceinline` works in the same way as the `inline` directive, but it forces
inlining by the compiler on a function call statement.
-* `!dir$ noinline` works in the same way as the `inline` directive, but prevents
+* `!dir$ noinline` works in the same way as the `inline` directive, but prevents
any attempt of inlining by the compiler on a function call statement.
# Directive Details
## Introduction
-Directives are commonly used in Fortran programs to specify additional actions
-to be performed by the compiler. The directives are always specified with the
+Directives are commonly used in Fortran programs to specify additional actions
+to be performed by the compiler. The directives are always specified with the
`!dir$` or `cdir$` prefix.
## Loop Directives
@@ -97,7 +99,7 @@ check that that construct matches the expected construct for the directive.
Skipping other intermediate directives allows multiple directives to appear on
the same construct.
-## Lowering
+## Lowering
Evaluation is extended with a new field called dirs for representing directives
associated with that Evaluation. When lowering loop directives, the associated
Do Loop's evaluation is found and the directive is added to it. This information
@@ -109,7 +111,7 @@ about the loop. For example, the `llvm.loop.vectorize.enable` metadata informs
the optimizer that a loop can be vectorized without considering its cost-model.
This attribute is added to the loop condition branch.
-### Representation in MLIR
+### Representation in MLIR
The MLIR LLVM dialect models this by an attribute called LoopAnnotation
Attribute. The attribute can be added to the latch of the loop in the cf
dialect and is then carried through lowering to the LLVM dialect.
diff --git a/flang/include/flang/Support/Fortran.h b/flang/include/flang/Support/Fortran.h
index ea0344ecb0830..cf39781c1e8a7 100644
--- a/flang/include/flang/Support/Fortran.h
+++ b/flang/include/flang/Support/Fortran.h
@@ -86,8 +86,9 @@ ENUM_CLASS(IgnoreTKR,
Rank, // R - don't check ranks
Device, // D - don't check host/device residence
Managed, // M - don't check managed storage
- Contiguous) // C - don't check for storage sequence association with a
+ Contiguous, // C - don't check for storage sequence association with a
// potentially non-contiguous object
+ Pointer) // P - ignore pointer and allocatable matching
using IgnoreTKRSet = EnumSet<IgnoreTKR, 8>;
// IGNORE_TKR(A) = IGNORE_TKR(TKRDM)
static constexpr IgnoreTKRSet ignoreTKRAll{IgnoreTKR::Type, IgnoreTKR::Kind,
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index c51d40b9e5039..995deaa12dd3b 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -914,7 +914,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
dummyName);
}
// INTENT(OUT) and INTENT(IN OUT) cases are caught elsewhere
- } else {
+ } else if (!actualIsAllocatable &&
+ !dummy.ignoreTKR.test(common::IgnoreTKR::Pointer)) {
messages.Say(
"ALLOCATABLE %s must be associated with an ALLOCATABLE actual argument"_err_en_US,
dummyName);
@@ -929,7 +930,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
dummy, actual, *scope,
/*isAssumedRank=*/dummyIsAssumedRank, actualIsPointer);
}
- } else if (!actualIsPointer) {
+ } else if (!actualIsPointer &&
+ !dummy.ignoreTKR.test(common::IgnoreTKR::Pointer)) {
messages.Say(
"Actual argument associated with POINTER %s must also be POINTER unless INTENT(IN)"_err_en_US,
dummyName);
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 549ee83b70fce..de407d3b1e125 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -949,7 +949,8 @@ void CheckHelper::CheckObjectEntity(
"!DIR$ IGNORE_TKR(R) may not apply in an ELEMENTAL procedure"_err_en_US);
}
if (IsPassedViaDescriptor(symbol)) {
- if (IsAllocatableOrObjectPointer(&symbol)) {
+ if (IsAllocatableOrObjectPointer(&symbol) &&
+ !ignoreTKR.test(common::IgnoreTKR::Pointer)) {
if (inExplicitExternalInterface) {
Warn(common::UsageWarning::IgnoreTKRUsage,
"!DIR$ IGNORE_TKR should not apply to an allocatable or pointer"_warn_en_US);
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 556259d1e5e63..b419864f73b8e 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -1021,6 +1021,9 @@ void ModFileWriter::PutObjectEntity(
case common::IgnoreTKR::Contiguous:
os << 'c';
break;
+ case common::IgnoreTKR::Pointer:
+ os << 'p';
+ break;
}
});
os << ") " << symbol.name() << '\n';
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 0e6d4c71b30de..f88af5fac0bbd 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -10109,6 +10109,9 @@ void ResolveNamesVisitor::Post(const parser::CompilerDirective &x) {
case 'c':
set.set(common::IgnoreTKR::Contiguous);
break;
+ case 'p':
+ set.set(common::IgnoreTKR::Pointer);
+ break;
case 'a':
set = common::ignoreTKRAll;
break;
diff --git a/flang/lib/Support/Fortran.cpp b/flang/lib/Support/Fortran.cpp
index 3a8ebbb7d61ef..05d6e0e709e91 100644
--- a/flang/lib/Support/Fortran.cpp
+++ b/flang/lib/Support/Fortran.cpp
@@ -95,6 +95,9 @@ std::string AsFortran(IgnoreTKRSet tkr) {
if (tkr.test(IgnoreTKR::Contiguous)) {
result += 'C';
}
+ if (tkr.test(IgnoreTKR::Pointer)) {
+ result += 'P';
+ }
return result;
}
diff --git a/flang/test/Semantics/ignore_tkr04.f90 b/flang/test/Semantics/ignore_tkr04.f90
new file mode 100644
index 0000000000000..8becc85857bb1
--- /dev/null
+++ b/flang/test/Semantics/ignore_tkr04.f90
@@ -0,0 +1,26 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Tests for ignore_tkr(p)
+module ignore_tkr_4_m
+interface
+ subroutine s(a)
+ real, pointer :: a(:)
+!dir$ ignore_tkr(p) a
+ end subroutine
+ subroutine s1(a)
+ real, allocatable :: a(:)
+!dir$ ignore_tkr(p) a
+ end subroutine
+end interface
+end module
+program t
+ use ignore_tkr_4_m
+ real, allocatable :: x(:)
+ real, pointer :: x1(:)
+ call s(x)
+!CHECK-NOT: error
+!CHECK-NOT: warning
+ call s1(x1)
+!CHECK-NOT: error
+!CHECK-NOT: warning
+end
+
More information about the flang-commits
mailing list