Skip to content

Commit 82ffcda

Browse files
committed
[flang] Allow interoperable object to have interoperable derived type that's not BIND(C)
An interoperable BIND(C) object with a derived type should have a BIND(C) derived type, but will now work with a derived type that satisfies all of the requirements of a BIND(C) derived type.
1 parent ab33fa5 commit 82ffcda

File tree

2 files changed

+11
-13
lines changed

2 files changed

+11
-13
lines changed

flang/lib/Semantics/check-declarations.cpp

Lines changed: 8 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -139,7 +139,7 @@ class CheckHelper {
139139
void CheckProcedureAssemblyName(const Symbol &symbol);
140140
void CheckExplicitSave(const Symbol &);
141141
parser::Messages WhyNotInteroperableDerivedType(const Symbol &, bool isError);
142-
parser::Messages WhyNotInteroperableObject(const Symbol &, bool isError);
142+
parser::Messages WhyNotInteroperableObject(const Symbol &);
143143
parser::Messages WhyNotInteroperableFunctionResult(const Symbol &);
144144
parser::Messages WhyNotInteroperableProcedure(const Symbol &, bool isError);
145145
void CheckBindC(const Symbol &);
@@ -2981,15 +2981,13 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
29812981
return msgs;
29822982
}
29832983

2984-
parser::Messages CheckHelper::WhyNotInteroperableObject(
2985-
const Symbol &symbol, bool isError) {
2984+
parser::Messages CheckHelper::WhyNotInteroperableObject(const Symbol &symbol) {
29862985
parser::Messages msgs;
29872986
if (examinedByWhyNotInteroperable_.find(symbol) !=
29882987
examinedByWhyNotInteroperable_.end()) {
29892988
return msgs;
29902989
}
29912990
bool isExplicitBindC{symbol.attrs().test(Attr::BIND_C)};
2992-
isError |= isExplicitBindC;
29932991
examinedByWhyNotInteroperable_.insert(symbol);
29942992
CHECK(symbol.has<ObjectEntityDetails>());
29952993
if (isExplicitBindC && !symbol.owner().IsModule()) {
@@ -3018,11 +3016,11 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(
30183016
}
30193017
if (const auto *type{symbol.GetType()}) {
30203018
const auto *derived{type->AsDerived()};
3021-
if (derived) {
3022-
if (derived->typeSymbol().attrs().test(Attr::BIND_C)) {
3023-
} else if (isError) {
3019+
if (derived && !derived->typeSymbol().attrs().test(Attr::BIND_C)) {
3020+
if (!context_.IsEnabled(
3021+
common::LanguageFeature::NonBindCInteroperability)) {
30243022
msgs.Say(symbol.name(),
3025-
"The derived type of a BIND(C) object must also be BIND(C)"_err_en_US)
3023+
"The derived type of an interoperable object must be BIND(C)"_err_en_US)
30263024
.Attach(derived->typeSymbol().name(), "Non-BIND(C) type"_en_US);
30273025
} else if (auto bad{WhyNotInteroperableDerivedType(
30283026
derived->typeSymbol(), /*isError=*/false)};
@@ -3155,7 +3153,7 @@ parser::Messages CheckHelper::WhyNotInteroperableProcedure(
31553153
"A dummy procedure of an interoperable procedure should be BIND(C)"_warn_en_US);
31563154
}
31573155
} else if (dummy->has<ObjectEntityDetails>()) {
3158-
dummyMsgs = WhyNotInteroperableObject(*dummy, /*isError=*/false);
3156+
dummyMsgs = WhyNotInteroperableObject(*dummy);
31593157
} else {
31603158
CheckBindC(*dummy);
31613159
}
@@ -3225,7 +3223,7 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
32253223
}
32263224
}
32273225
if (symbol.has<ObjectEntityDetails>()) {
3228-
whyNot = WhyNotInteroperableObject(symbol, /*isError=*/isExplicitBindC);
3226+
whyNot = WhyNotInteroperableObject(symbol);
32293227
} else if (symbol.has<ProcEntityDetails>() ||
32303228
symbol.has<SubprogramDetails>()) {
32313229
whyNot = WhyNotInteroperableProcedure(symbol, /*isError=*/isExplicitBindC);

flang/test/Semantics/declarations02.f90

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
! RUN: %python %S/test_errors.py %s %flang_fc1
1+
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
22

33
module m
44
!ERROR: 'x1' may not have both the BIND(C) and PARAMETER attributes
@@ -32,14 +32,14 @@ module m
3232
end type
3333

3434
!ERROR: 't1' may not have both the BIND(C) and PARAMETER attributes
35-
!ERROR: The derived type of a BIND(C) object must also be BIND(C)
35+
!WARNING: The derived type of an interoperable object should be BIND(C)
3636
type(my_type1), bind(c), parameter :: t1 = my_type1(1)
3737
!ERROR: 't2' may not have both the BIND(C) and PARAMETER attributes
3838
type(my_type2), bind(c), parameter :: t2 = my_type2(1)
3939

4040
type(my_type2), parameter :: t3 = my_type2(1) ! no error
4141
!ERROR: 't4' may not have both the BIND(C) and PARAMETER attributes
42-
!ERROR: The derived type of a BIND(C) object must also be BIND(C)
42+
!WARNING: The derived type of an interoperable object should be BIND(C)
4343
type(my_type1), parameter :: t4 = my_type1(1)
4444
!ERROR: 't5' may not have both the BIND(C) and PARAMETER attributes
4545
type(my_type2), parameter :: t5 = my_type2(1)

0 commit comments

Comments
 (0)