diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -200,6 +200,10 @@ * Multiple specifications of the SAVE attribute on the same object are allowed, with a warning. * Specific intrinsic functions BABS, IIABS, JIABS, KIABS, ZABS, and CDABS. +* A `POINTER` component's type need not be a sequence type when + the component appears in a derived type with `SEQUENCE`. + (This case should probably be an exception to constraint C740 in + the standard.) ### Extensions supported when enabled by options diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h --- a/flang/include/flang/Common/Fortran-features.h +++ b/flang/include/flang/Common/Fortran-features.h @@ -31,7 +31,7 @@ OldLabelDoEndStatements, LogicalIntegerAssignment, EmptySourceFile, ProgramReturn, ImplicitNoneTypeNever, ImplicitNoneTypeAlways, ForwardRefDummyImplicitNone, OpenAccessAppend, BOZAsDefaultInteger, - DistinguishableSpecifics, DefaultSave) + DistinguishableSpecifics, DefaultSave, PointerInSeqType) using LanguageFeatures = EnumSet; diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -4296,8 +4296,14 @@ if (derivedTypeInfo_.sequence) { // C740 if (const auto *declType{GetDeclTypeSpec()}) { if (!declType->AsIntrinsic() && !declType->IsSequenceType()) { - Say("A sequence type data component must either be of an" - " intrinsic type or a derived sequence type"_err_en_US); + if (GetAttrs().test(Attr::POINTER) && + context().IsEnabled(common::LanguageFeature::PointerInSeqType)) { + if (context().ShouldWarn(common::LanguageFeature::PointerInSeqType)) { + Say("A sequence type data component that is a pointer to a non-sequence type is not standard"_en_US); + } + } else { + Say("A sequence type data component must either be of an intrinsic type or a derived sequence type"_err_en_US); + } } } } diff --git a/flang/test/Semantics/resolve31.f90 b/flang/test/Semantics/resolve31.f90 --- a/flang/test/Semantics/resolve31.f90 +++ b/flang/test/Semantics/resolve31.f90 @@ -83,6 +83,8 @@ class(*), allocatable :: typeStarField !ERROR: A sequence type data component must either be of an intrinsic type or a derived sequence type type(plainType) :: testField1 + !Pointers are ok as an extension + type(plainType), pointer :: testField1p type(sequenceType) :: testField2 procedure(real), pointer, nopass :: procField end type testType