Skip to content

Commit fd95cab

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 8bcf40b commit fd95cab

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
@@ -143,7 +143,7 @@ class CheckHelper {
143143
void CheckProcedureAssemblyName(const Symbol &symbol);
144144
void CheckExplicitSave(const Symbol &);
145145
parser::Messages WhyNotInteroperableDerivedType(const Symbol &);
146-
parser::Messages WhyNotInteroperableObject(const Symbol &, bool isError);
146+
parser::Messages WhyNotInteroperableObject(const Symbol &);
147147
parser::Messages WhyNotInteroperableFunctionResult(const Symbol &);
148148
parser::Messages WhyNotInteroperableProcedure(const Symbol &, bool isError);
149149
void CheckBindC(const Symbol &);
@@ -3012,15 +3012,13 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
30123012
return msgs;
30133013
}
30143014

3015-
parser::Messages CheckHelper::WhyNotInteroperableObject(
3016-
const Symbol &symbol, bool isError) {
3015+
parser::Messages CheckHelper::WhyNotInteroperableObject(const Symbol &symbol) {
30173016
parser::Messages msgs;
30183017
if (examinedByWhyNotInteroperable_.find(symbol) !=
30193018
examinedByWhyNotInteroperable_.end()) {
30203019
return msgs;
30213020
}
30223021
bool isExplicitBindC{symbol.attrs().test(Attr::BIND_C)};
3023-
isError |= isExplicitBindC;
30243022
examinedByWhyNotInteroperable_.insert(symbol);
30253023
CHECK(symbol.has<ObjectEntityDetails>());
30263024
if (isExplicitBindC && !symbol.owner().IsModule()) {
@@ -3049,11 +3047,11 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(
30493047
}
30503048
if (const auto *type{symbol.GetType()}) {
30513049
const auto *derived{type->AsDerived()};
3052-
if (derived) {
3053-
if (derived->typeSymbol().attrs().test(Attr::BIND_C)) {
3054-
} else if (isError) {
3050+
if (derived && !derived->typeSymbol().attrs().test(Attr::BIND_C)) {
3051+
if (!context_.IsEnabled(
3052+
common::LanguageFeature::NonBindCInteroperability)) {
30553053
msgs.Say(symbol.name(),
3056-
"The derived type of a BIND(C) object must also be BIND(C)"_err_en_US)
3054+
"The derived type of an interoperable object must be BIND(C)"_err_en_US)
30573055
.Attach(derived->typeSymbol().name(), "Non-BIND(C) type"_en_US);
30583056
} else if (auto bad{
30593057
WhyNotInteroperableDerivedType(derived->typeSymbol())};
@@ -3186,7 +3184,7 @@ parser::Messages CheckHelper::WhyNotInteroperableProcedure(
31863184
"A dummy procedure of an interoperable procedure should be BIND(C)"_warn_en_US);
31873185
}
31883186
} else if (dummy->has<ObjectEntityDetails>()) {
3189-
dummyMsgs = WhyNotInteroperableObject(*dummy, /*isError=*/false);
3187+
dummyMsgs = WhyNotInteroperableObject(*dummy);
31903188
} else {
31913189
CheckBindC(*dummy);
31923190
}
@@ -3256,7 +3254,7 @@ void CheckHelper::CheckBindC(const Symbol &symbol) {
32563254
}
32573255
}
32583256
if (symbol.has<ObjectEntityDetails>()) {
3259-
whyNot = WhyNotInteroperableObject(symbol, /*isError=*/isExplicitBindC);
3257+
whyNot = WhyNotInteroperableObject(symbol);
32603258
} else if (symbol.has<ProcEntityDetails>() ||
32613259
symbol.has<SubprogramDetails>()) {
32623260
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)