-
Notifications
You must be signed in to change notification settings - Fork 11.6k
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
[flang] Add warnings for non-standard C_F_POINTER() usage #78332
Conversation
There's a few restrictions in the standard on the Fortran pointer argument (FPTR=) to the intrinsic subroutine C_F_POINTER() that almost no compilers enforce. Enforce them here with warnings.
@llvm/pr-subscribers-flang-semantics Author: Peter Klausler (klausler) ChangesThere's a few restrictions in the standard on the Fortran pointer argument (FPTR=) to the intrinsic subroutine C_F_POINTER() that almost no compilers enforce. Enforce them here with warnings. Full diff: https://github.com/llvm/llvm-project/pull/78332.diff 2 Files Affected:
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index da6d5970089884..7d2e45dcbe96de 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2663,13 +2663,28 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
}
if (const auto *expr{arguments[1].value().UnwrapExpr()}) {
int fptrRank{expr->Rank()};
+ auto at{arguments[1]->sourceLocation()};
if (auto type{expr->GetType()}) {
if (type->HasDeferredTypeParameter()) {
- context.messages().Say(arguments[1]->sourceLocation(),
+ context.messages().Say(at,
"FPTR= argument to C_F_POINTER() may not have a deferred type parameter"_err_en_US);
+ } else if (type->category() == TypeCategory::Derived) {
+ if (type->IsUnlimitedPolymorphic()) {
+ context.messages().Say(at,
+ "FPTR= argument to C_F_POINTER() should not be unlimited polymorphic"_warn_en_US);
+ } else if (!type->GetDerivedTypeSpec().typeSymbol().attrs().test(
+ semantics::Attr::BIND_C)) {
+ context.messages().Say(at,
+ "FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)"_warn_en_US);
+ }
+ } else if (!IsInteroperableIntrinsicType(
+ *type, &context.languageFeatures())) {
+ context.messages().Say(at,
+ "FPTR= argument to C_F_POINTER() should not have the non-interoperable intrinsic type %s"_warn_en_US,
+ type->AsFortran());
}
if (ExtractCoarrayRef(*expr)) {
- context.messages().Say(arguments[1]->sourceLocation(),
+ context.messages().Say(at,
"FPTR= argument to C_F_POINTER() may not be a coindexed object"_err_en_US);
}
characteristics::DummyDataObject fptr{
@@ -2678,8 +2693,8 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
fptr.attrs.set(characteristics::DummyDataObject::Attr::Pointer);
dummies.emplace_back("fptr"s, std::move(fptr));
} else {
- context.messages().Say(arguments[1]->sourceLocation(),
- "FPTR= argument to C_F_POINTER() must have a type"_err_en_US);
+ context.messages().Say(
+ at, "FPTR= argument to C_F_POINTER() must have a type"_err_en_US);
}
if (arguments[2] && fptrRank == 0) {
context.messages().Say(arguments[2]->sourceLocation(),
diff --git a/flang/test/Semantics/c_f_pointer.f90 b/flang/test/Semantics/c_f_pointer.f90
index 0c1e8544b02b18..c2529201ee2659 100644
--- a/flang/test/Semantics/c_f_pointer.f90
+++ b/flang/test/Semantics/c_f_pointer.f90
@@ -1,4 +1,4 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! Enforce 18.2.3.3
program test
@@ -12,6 +12,12 @@ program test
character(len=:), pointer :: charDeferredF
integer :: j
integer, dimension(2, 2) :: rankTwoArray
+ class(*), pointer :: unlimited
+ type :: notBindCType
+ integer :: n
+ end type
+ type(notBindCType), pointer :: notBindC
+ character(2), pointer :: c2ptr
rankTwoArray = reshape([1, 2, 3, 4], shape(rankTwoArray))
call c_f_pointer(scalarC, scalarIntF) ! ok
call c_f_pointer(scalarC, arrayIntF, [1_8]) ! ok
@@ -38,4 +44,10 @@ program test
call c_f_pointer(scalarC, multiDimIntF, shape=[1_8])
!ERROR: SHAPE= argument to C_F_POINTER() must be a rank-one array.
call c_f_pointer(scalarC, multiDimIntF, shape=rankTwoArray)
+ !WARNING: FPTR= argument to C_F_POINTER() should not be unlimited polymorphic
+ call c_f_pointer(scalarC, unlimited)
+ !WARNING: FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)
+ call c_f_pointer(scalarC, notBindC)
+ !WARNING: FPTR= argument to C_F_POINTER() should not have the non-interoperable intrinsic type CHARACTER(KIND=1,LEN=2_8)
+ call c_f_pointer(scalarC, c2ptr)
end program
|
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Looks great, thanks
There's a few restrictions in the standard on the Fortran pointer argument (FPTR=) to the intrinsic subroutine C_F_POINTER() that almost no compilers enforce. Enforce them here with warnings.