[flang-commits] [clang] [flang] [flang][semantics] Add a flag to relax some of the semantic constraints on C_LOC (PR #195112)
Andre Kuhlenschmidt via flang-commits
flang-commits at lists.llvm.org
Fri May 1 09:01:55 PDT 2026
https://github.com/akuhlens updated https://github.com/llvm/llvm-project/pull/195112
>From b5725a12452fe528c687a7dedde9029aeecd8671 Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Thu, 30 Apr 2026 08:29:40 -0700
Subject: [PATCH 1/4] initial commit
---
clang/include/clang/Options/FlangOptions.td | 11 +++++
.../include/flang/Support/Fortran-features.h | 4 +-
flang/lib/Evaluate/intrinsics.cpp | 47 +++++++++++++------
flang/lib/Frontend/CompilerInvocation.cpp | 6 +++
flang/lib/Support/Fortran-features.cpp | 1 +
5 files changed, 53 insertions(+), 16 deletions(-)
diff --git a/clang/include/clang/Options/FlangOptions.td b/clang/include/clang/Options/FlangOptions.td
index ffb64646709df..28fb199ff1b61 100644
--- a/clang/include/clang/Options/FlangOptions.td
+++ b/clang/include/clang/Options/FlangOptions.td
@@ -291,6 +291,17 @@ defm unsafe_cray_pointers : BoolOptionWithoutMarshalling<"f", "unsafe-cray-point
PosFlag<SetTrue, [], [FlangOption, FC1Option], "Optimizations allow for unsafe Cray pointer usages">,
NegFlag<SetFalse, [], [FlangOption, FC1Option], "Optimizations don't allow for unsafe Cray pointer usages (default)">>;
+defm relaxed_c_loc : Flag<["-"], "frelaxed-c-loc">, Group<f_Group>,
+ Visibility<[FlangOption, FC1Option]>,
+ HelpText<"Unsafe relaxation of C_LOC() argument restrictions for compatibility">,
+ DocBrief<[{
+ Unsafe relaxation of C_LOC() argument restrictions for compatibility.
+ All C_LOC values should be passed directly to C calls.
+
+ This is unsafe, because it can be used to create aliases the compiler
+ is unaware of, please fix your applications instead of using this flag.
+ This may be removed in the future.}]>;
+
def fhermetic_module_files : Flag<["-"], "fhermetic-module-files">, Group<f_Group>,
HelpText<"Emit hermetic module files (no nested USE association)">;
diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h
index df93eaa8b4936..af72b71d9d1e6 100644
--- a/flang/include/flang/Support/Fortran-features.h
+++ b/flang/include/flang/Support/Fortran-features.h
@@ -59,7 +59,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
PointerPassObject, MultipleIdenticalDATA,
DefaultStructConstructorNullPointer, AssumedRankIoItem,
MultipleProgramUnitsOnSameLine, AllocatedForAssociated,
- OpenMPThreadprivateEquivalence)
+ OpenMPThreadprivateEquivalence, RelaxedCLoc)
// Portability and suspicious usage warnings
ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
@@ -85,7 +85,7 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
RealConstantWidening, VolatileOrAsynchronousTemporary, UnusedVariable,
UsedUndefinedVariable, BadValueInDeadCode, AssumedTypeSizeDummy,
MisplacedIgnoreTKR, NamelistParameter, ImpureFinalInPure,
- IgnoredNoReallocateLHS)
+ IgnoredNoReallocateLHS, CLoc)
using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>;
using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 84cd2288fcd0b..79ea6414666e3 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3498,11 +3498,26 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::HandleC_Loc(
CHECK(arguments.size() == 1);
CheckForCoindexedObject(context.messages(), arguments[0], "c_loc", "x");
const auto *expr{arguments[0].value().UnwrapExpr()};
+ SpecificCall specificCall{
+ SpecificIntrinsic{"__builtin_c_loc"s,
+ characteristics::Procedure{
+ characteristics::FunctionResult{DynamicType{
+ GetBuiltinDerivedType(builtinsScope_, "__builtin_c_ptr")}},
+ characteristics::DummyArguments{},
+ characteristics::Procedure::Attrs{
+ characteristics::Procedure::Attr::Pure}}},
+ {/*arguments*/}};
if (expr &&
!(IsObjectPointer(*expr) ||
(IsVariable(*expr) && GetLastTarget(GetSymbolVector(*expr))))) {
- context.messages().Say(arguments[0]->sourceLocation(),
- "C_LOC() argument must be a data pointer or target"_err_en_US);
+ if (context.languageFeatures().IsEnabled(
+ common::LanguageFeature::RelaxedCLoc)) {
+ context.Warn(common::UsageWarning::CLoc, arguments[0]->sourceLocation(),
+ "C_LOC() argument must be a data pointer or target"_warn_en_US);
+ } else {
+ context.messages().Say(arguments[0]->sourceLocation(),
+ "C_LOC() argument must be a data pointer or target"_err_en_US);
+ }
}
if (auto typeAndShape{characteristics::TypeAndShape::Characterize(
arguments[0], context)}) {
@@ -3539,20 +3554,24 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::HandleC_Loc(
"C_LOC() argument has non-interoperable intrinsic type or kind"_warn_en_US);
}
}
-
characteristics::DummyDataObject ddo{std::move(*typeAndShape)};
ddo.intent = common::Intent::In;
- return SpecificCall{
- SpecificIntrinsic{"__builtin_c_loc"s,
- characteristics::Procedure{
- characteristics::FunctionResult{
- DynamicType{GetBuiltinDerivedType(
- builtinsScope_, "__builtin_c_ptr")}},
- characteristics::DummyArguments{
- characteristics::DummyArgument{"x"s, std::move(ddo)}},
- characteristics::Procedure::Attrs{
- characteristics::Procedure::Attr::Pure}}},
- std::move(arguments)};
+ specificCall.specificIntrinsic.characteristics.value()
+ .dummyArguments.emplace_back(std::move(ddo));
+ specificCall.arguments.emplace_back(std::move(arguments[0]));
+ return specificCall;
+ } else if (expr && IsProcedurePointer(*expr)) {
+ auto dummyArg{characteristics::DummyArgument::FromActual(
+ "x", *expr, context, /*forImplicitInterface=*/false)};
+ CHECK(dummyArg.has_value());
+ dummyArg->intent = common::Intent::In;
+ specificCall.specificIntrinsic.characteristics.value()
+ .dummyArguments.emplace_back(std::move(*dummyArg));
+ specificCall.arguments.emplace_back(std::move(arguments[0]));
+ return specificCall;
+ } else {
+ context.messages().Say(arguments[0]->sourceLocation(),
+ "C_LOC() argument must be a object or procedure"_err_en_US);
}
}
return std::nullopt;
diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp
index a1508f40bf490..fbdc0cec67866 100644
--- a/flang/lib/Frontend/CompilerInvocation.cpp
+++ b/flang/lib/Frontend/CompilerInvocation.cpp
@@ -869,6 +869,12 @@ static bool parseFrontendArgs(FrontendOptions &opts, llvm::opt::ArgList &args,
args.hasFlag(clang::options::OPT_funsigned,
clang::options::OPT_fno_unsigned, false));
+ // -f{no-}relaxed-c-loc
+ opts.features.Enable(Fortran::common::LanguageFeature::RelaxedCLoc,
+ args.hasFlag(clang::options::OPT_frelaxed_c_loc,
+ clang::options::OPT_fno_relaxed_c_loc,
+ false));
+
// -f{no-}xor-operator
opts.features.Enable(Fortran::common::LanguageFeature::XOROperator,
args.hasFlag(clang::options::OPT_fxor_operator,
diff --git a/flang/lib/Support/Fortran-features.cpp b/flang/lib/Support/Fortran-features.cpp
index d8f7b4f6e58e7..4cb4e745a4f38 100644
--- a/flang/lib/Support/Fortran-features.cpp
+++ b/flang/lib/Support/Fortran-features.cpp
@@ -213,6 +213,7 @@ LanguageFeatureControl::LanguageFeatureControl() {
warnUsage_.set(UsageWarning::MisplacedIgnoreTKR);
warnUsage_.set(UsageWarning::ImpureFinalInPure);
warnUsage_.set(UsageWarning::IgnoredNoReallocateLHS);
+ warnUsage_.set(UsageWarning::CLoc);
warnLanguage_.set(LanguageFeature::OpenMPThreadprivateEquivalence);
}
>From d266731b7b4febbfb9b1e56fc14bf925f853790b Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Thu, 30 Apr 2026 11:09:25 -0700
Subject: [PATCH 2/4] add forgotten test cases
---
flang/test/Semantics/c_loc01-relaxed.f90 | 97 ++++++++++++++++++++++++
1 file changed, 97 insertions(+)
create mode 100644 flang/test/Semantics/c_loc01-relaxed.f90
diff --git a/flang/test/Semantics/c_loc01-relaxed.f90 b/flang/test/Semantics/c_loc01-relaxed.f90
new file mode 100644
index 0000000000000..59c51e17d7fc2
--- /dev/null
+++ b/flang/test/Semantics/c_loc01-relaxed.f90
@@ -0,0 +1,97 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -frelaxed-c-loc -pedantic
+module m
+ use iso_c_binding
+ type haslen(L)
+ integer, len :: L
+ end type
+ integer, target :: targ
+ contains
+ subroutine subr
+ end
+ subroutine test(assumedType, poly, nclen, n)
+ type(*), target :: assumedType
+ class(*), target :: poly
+ type(c_ptr) cp
+ type(c_funptr) cfp
+ real notATarget
+ !PORTABILITY: Procedure pointer 'pptr' should not have an ELEMENTAL intrinsic as its interface [-Wportability]
+ procedure(sin), pointer :: pptr
+ real, target :: arr(3)
+ type(hasLen(1)), target :: clen
+ type(hasLen(*)), target :: nclen
+ integer, intent(in) :: n
+ character(2), target :: ch
+ character(1,4), target :: unicode
+ real :: arr1(purefun1(c_loc(targ))) ! ok
+ real :: arr2(purefun2(c_funloc(subr))) ! ok
+ character(:), allocatable, target :: deferred
+ character(n), pointer :: p2ch
+ !WARNING: C_LOC() argument must be a data pointer or target [-Wc-loc]
+ cp = c_loc(notATarget)
+ !WARNING: C_LOC() argument must be a data pointer or target [-Wc-loc]
+ cp = c_loc(pptr)
+ !ERROR: C_LOC() argument must be contiguous
+ cp = c_loc(arr(1:3:2))
+ !ERROR: C_LOC() argument may not be a zero-sized array
+ cp = c_loc(arr(3:1))
+ !ERROR: C_LOC() argument must have an intrinsic type, assumed type, or non-polymorphic derived type with no non-constant length parameter
+ cp = c_loc(poly)
+ cp = c_loc(clen) ! ok
+ !ERROR: C_LOC() argument must have an intrinsic type, assumed type, or non-polymorphic derived type with no non-constant length parameter
+ cp = c_loc(nclen)
+ !ERROR: C_LOC() argument may not be zero-length character
+ cp = c_loc(ch(2:1))
+ !WARNING: C_LOC() argument has non-interoperable character length [-Wcharacter-interoperability]
+ cp = c_loc(ch)
+ !WARNING: C_LOC() argument has non-interoperable intrinsic type or kind [-Winteroperability]
+ cp = c_loc(unicode)
+ cp = c_loc(ch(1:1)) ! ok
+ cp = c_loc(deferred) ! ok
+ cp = c_loc(p2ch) ! ok
+ !ERROR: PRIVATE name '__address' is accessible only within module '__fortran_builtins'
+ cp = c_ptr(0)
+ !ERROR: PRIVATE name '__address' is accessible only within module '__fortran_builtins'
+ cfp = c_funptr(0)
+ !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(c_ptr) and TYPE(c_funptr)
+ cp = cfp
+ !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(c_funptr) and TYPE(c_ptr)
+ cfp = cp
+ end
+ pure integer function purefun1(p)
+ type(c_ptr), intent(in) :: p
+ purefun1 = 1
+ end
+ pure integer function purefun2(p)
+ type(c_funptr), intent(in) :: p
+ purefun2 = 1
+ end
+end module
+
+module m2
+ use iso_c_binding
+ ! In this context (structure constructor from intrinsic module being used directly
+ ! in another module), emit only a warning, since this module might have originally
+ ! been a module file that was converted back into Fortran.
+ !WARNING: PRIVATE name '__address' is accessible only within module '__fortran_builtins'
+ type(c_ptr) :: p = c_ptr(0)
+end
+
+module m3
+ use iso_c_binding
+ real, target :: modtarg
+ contains
+ subroutine helper()
+ end subroutine
+ subroutine test
+ type(c_ptr) :: cp
+ real :: notATarget
+ real, target :: localtarg
+ procedure(helper), pointer :: pptr
+ cp = c_loc(modtarg) ! ok
+ cp = c_loc(localtarg) ! ok
+ !WARNING: C_LOC() argument must be a data pointer or target [-Wc-loc]
+ cp = c_loc(notATarget)
+ !WARNING: C_LOC() argument must be a data pointer or target [-Wc-loc]
+ cp = c_loc(pptr)
+ end subroutine
+end module
>From 919327cbc07ac291c41e626ea764e7553385c2b6 Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Fri, 1 May 2026 09:00:04 -0700
Subject: [PATCH 3/4] addressing feedback
---
clang/include/clang/Options/FlangOptions.td | 2 +-
flang/lib/Evaluate/intrinsics.cpp | 5 ++---
flang/lib/Frontend/CompilerInvocation.cpp | 9 ++++-----
flang/lib/Support/Fortran-features.cpp | 1 +
flang/test/Semantics/c_loc01-relaxed.f90 | 11 +++++++----
5 files changed, 15 insertions(+), 13 deletions(-)
diff --git a/clang/include/clang/Options/FlangOptions.td b/clang/include/clang/Options/FlangOptions.td
index 28fb199ff1b61..1ab83b6ffbbad 100644
--- a/clang/include/clang/Options/FlangOptions.td
+++ b/clang/include/clang/Options/FlangOptions.td
@@ -291,7 +291,7 @@ defm unsafe_cray_pointers : BoolOptionWithoutMarshalling<"f", "unsafe-cray-point
PosFlag<SetTrue, [], [FlangOption, FC1Option], "Optimizations allow for unsafe Cray pointer usages">,
NegFlag<SetFalse, [], [FlangOption, FC1Option], "Optimizations don't allow for unsafe Cray pointer usages (default)">>;
-defm relaxed_c_loc : Flag<["-"], "frelaxed-c-loc">, Group<f_Group>,
+def relaxed_c_loc : Flag<["-"], "frelaxed-c-loc">, Group<f_Group>,
Visibility<[FlangOption, FC1Option]>,
HelpText<"Unsafe relaxation of C_LOC() argument restrictions for compatibility">,
DocBrief<[{
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 79ea6414666e3..454905742ac79 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3513,7 +3513,7 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::HandleC_Loc(
if (context.languageFeatures().IsEnabled(
common::LanguageFeature::RelaxedCLoc)) {
context.Warn(common::UsageWarning::CLoc, arguments[0]->sourceLocation(),
- "C_LOC() argument must be a data pointer or target"_warn_en_US);
+ "C_LOC() argument should be a data pointer or target"_warn_en_US);
} else {
context.messages().Say(arguments[0]->sourceLocation(),
"C_LOC() argument must be a data pointer or target"_err_en_US);
@@ -3557,14 +3557,13 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::HandleC_Loc(
characteristics::DummyDataObject ddo{std::move(*typeAndShape)};
ddo.intent = common::Intent::In;
specificCall.specificIntrinsic.characteristics.value()
- .dummyArguments.emplace_back(std::move(ddo));
+ .dummyArguments.emplace_back(characteristics::DummyArgument{"x", std::move(ddo)});
specificCall.arguments.emplace_back(std::move(arguments[0]));
return specificCall;
} else if (expr && IsProcedurePointer(*expr)) {
auto dummyArg{characteristics::DummyArgument::FromActual(
"x", *expr, context, /*forImplicitInterface=*/false)};
CHECK(dummyArg.has_value());
- dummyArg->intent = common::Intent::In;
specificCall.specificIntrinsic.characteristics.value()
.dummyArguments.emplace_back(std::move(*dummyArg));
specificCall.arguments.emplace_back(std::move(arguments[0]));
diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp
index fbdc0cec67866..e7f4762e167fb 100644
--- a/flang/lib/Frontend/CompilerInvocation.cpp
+++ b/flang/lib/Frontend/CompilerInvocation.cpp
@@ -869,11 +869,10 @@ static bool parseFrontendArgs(FrontendOptions &opts, llvm::opt::ArgList &args,
args.hasFlag(clang::options::OPT_funsigned,
clang::options::OPT_fno_unsigned, false));
- // -f{no-}relaxed-c-loc
- opts.features.Enable(Fortran::common::LanguageFeature::RelaxedCLoc,
- args.hasFlag(clang::options::OPT_frelaxed_c_loc,
- clang::options::OPT_fno_relaxed_c_loc,
- false));
+ // -frelaxed-c-loc
+ if (args.hasArg(clang::options::OPT_relaxed_c_loc)) {
+ opts.features.Enable(Fortran::common::LanguageFeature::RelaxedCLoc);
+ }
// -f{no-}xor-operator
opts.features.Enable(Fortran::common::LanguageFeature::XOROperator,
diff --git a/flang/lib/Support/Fortran-features.cpp b/flang/lib/Support/Fortran-features.cpp
index 4cb4e745a4f38..54c8931da17d3 100644
--- a/flang/lib/Support/Fortran-features.cpp
+++ b/flang/lib/Support/Fortran-features.cpp
@@ -139,6 +139,7 @@ LanguageFeatureControl::LanguageFeatureControl() {
disable_.set(LanguageFeature::ImplicitNoneExternal);
disable_.set(LanguageFeature::DefaultSave);
disable_.set(LanguageFeature::SaveMainProgram);
+ disable_.set(LanguageFeature::RelaxedCLoc);
// These features, if enabled, conflict with valid standard usage,
// so there are disabled here by default.
disable_.set(LanguageFeature::BackslashEscapes);
diff --git a/flang/test/Semantics/c_loc01-relaxed.f90 b/flang/test/Semantics/c_loc01-relaxed.f90
index 59c51e17d7fc2..94bca594e8d4a 100644
--- a/flang/test/Semantics/c_loc01-relaxed.f90
+++ b/flang/test/Semantics/c_loc01-relaxed.f90
@@ -26,9 +26,9 @@ subroutine test(assumedType, poly, nclen, n)
real :: arr2(purefun2(c_funloc(subr))) ! ok
character(:), allocatable, target :: deferred
character(n), pointer :: p2ch
- !WARNING: C_LOC() argument must be a data pointer or target [-Wc-loc]
+ !WARNING: C_LOC() argument should be a data pointer or target [-Wc-loc]
cp = c_loc(notATarget)
- !WARNING: C_LOC() argument must be a data pointer or target [-Wc-loc]
+ !WARNING: C_LOC() argument should be a data pointer or target [-Wc-loc]
cp = c_loc(pptr)
!ERROR: C_LOC() argument must be contiguous
cp = c_loc(arr(1:3:2))
@@ -89,9 +89,12 @@ subroutine test
procedure(helper), pointer :: pptr
cp = c_loc(modtarg) ! ok
cp = c_loc(localtarg) ! ok
- !WARNING: C_LOC() argument must be a data pointer or target [-Wc-loc]
+ !WARNING: C_LOC() argument should be a data pointer or target [-Wc-loc]
cp = c_loc(notATarget)
- !WARNING: C_LOC() argument must be a data pointer or target [-Wc-loc]
+ !WARNING: C_LOC() argument should be a data pointer or target [-Wc-loc]
cp = c_loc(pptr)
+ !ERROR: C_LOC() argument must be a object or procedure
+ !ERROR: alternate return specification may not appear on function reference
+10 cp = c_loc(*10)
end subroutine
end module
>From 12039281e8fac1f5543d0087f98e3456b170040c Mon Sep 17 00:00:00 2001
From: Andre Kuhlenschmidt <akuhlenschmi at nvidia.com>
Date: Fri, 1 May 2026 09:00:41 -0700
Subject: [PATCH 4/4] clang format
---
flang/lib/Evaluate/intrinsics.cpp | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 454905742ac79..87b041238071f 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3557,7 +3557,8 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::HandleC_Loc(
characteristics::DummyDataObject ddo{std::move(*typeAndShape)};
ddo.intent = common::Intent::In;
specificCall.specificIntrinsic.characteristics.value()
- .dummyArguments.emplace_back(characteristics::DummyArgument{"x", std::move(ddo)});
+ .dummyArguments.emplace_back(
+ characteristics::DummyArgument{"x", std::move(ddo)});
specificCall.arguments.emplace_back(std::move(arguments[0]));
return specificCall;
} else if (expr && IsProcedurePointer(*expr)) {
More information about the flang-commits
mailing list