diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h index 5b22313754a0f..6cb1bcdb0003f 100644 --- a/flang/include/flang/Support/Fortran-features.h +++ b/flang/include/flang/Support/Fortran-features.h @@ -76,7 +76,7 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable, MismatchingDummyProcedure, SubscriptedEmptyArray, UnsignedLiteralTruncation, CompatibleDeclarationsFromDistinctModules, NullActualForDefaultIntentAllocatable, UseAssociationIntoSameNameSubprogram, - HostAssociatedIntentOutInSpecExpr) + HostAssociatedIntentOutInSpecExpr, NonVolatilePointerToVolatile) using LanguageFeatures = EnumSet; using UsageWarnings = EnumSet; diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp index ab3771c808761..36c9c5b845706 100644 --- a/flang/lib/Semantics/pointer-assignment.cpp +++ b/flang/lib/Semantics/pointer-assignment.cpp @@ -360,6 +360,20 @@ bool PointerAssignmentChecker::Check(const evaluate::Designator &d) { } else { Say(std::get(*msg)); } + } + + // Show warnings after errors + + // 8.5.20(3) A pointer should have the VOLATILE attribute if its target has + // the VOLATILE attribute + // 8.5.20(4) If an object has the VOLATILE attribute, then all of its + // subobjects also have the VOLATILE attribute. + if (!isVolatile_ && base->attrs().test(Attr::VOLATILE)) { + Warn(common::UsageWarning::NonVolatilePointerToVolatile, + "VOLATILE target associated with non-VOLATILE pointer"_warn_en_US); + } + + if (msg) { return false; } else { context_.NoteDefinedSymbol(*base); diff --git a/flang/lib/Support/Fortran-features.cpp b/flang/lib/Support/Fortran-features.cpp index b3cb62e62f5fb..49a5989849eaa 100644 --- a/flang/lib/Support/Fortran-features.cpp +++ b/flang/lib/Support/Fortran-features.cpp @@ -87,6 +87,7 @@ LanguageFeatureControl::LanguageFeatureControl() { warnUsage_.set(UsageWarning::NullActualForDefaultIntentAllocatable); warnUsage_.set(UsageWarning::UseAssociationIntoSameNameSubprogram); warnUsage_.set(UsageWarning::HostAssociatedIntentOutInSpecExpr); + warnUsage_.set(UsageWarning::NonVolatilePointerToVolatile); // New warnings, on by default warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr); warnLanguage_.set(LanguageFeature::NullActualForAllocatable); diff --git a/flang/test/Semantics/assign02.f90 b/flang/test/Semantics/assign02.f90 index 6775506c21a3b..d83d126e2734c 100644 --- a/flang/test/Semantics/assign02.f90 +++ b/flang/test/Semantics/assign02.f90 @@ -9,6 +9,9 @@ module m1 sequence real :: t2Field end type + type t3 + type(t2) :: t3Field + end type contains ! C852 @@ -80,6 +83,7 @@ subroutine s5 real, pointer, volatile :: q p => x !ERROR: Pointer must be VOLATILE when target is a VOLATILE coarray + !ERROR: VOLATILE target associated with non-VOLATILE pointer p => y !ERROR: Pointer may not be VOLATILE when target is a non-VOLATILE coarray q => x @@ -165,6 +169,36 @@ subroutine s11 ca[1]%p => x end + subroutine s12 + real, volatile, target :: x + real, pointer :: p + real, pointer, volatile :: q + !ERROR: VOLATILE target associated with non-VOLATILE pointer + p => x + q => x + end + + subroutine s13 + type(t3), target, volatile :: y = t3(t2(4.4)) + real, pointer :: p1 + type(t2), pointer :: p2 + type(t3), pointer :: p3 + real, pointer, volatile :: q1 + type(t2), pointer, volatile :: q2 + type(t3), pointer, volatile :: q3 + !ERROR: VOLATILE target associated with non-VOLATILE pointer + p1 => y%t3Field%t2Field + !ERROR: VOLATILE target associated with non-VOLATILE pointer + p2 => y%t3Field + !ERROR: VOLATILE target associated with non-VOLATILE pointer + p3 => y + !OK: + q1 => y%t3Field%t2Field + !OK: + q2 => y%t3Field + !OK: + q3 => y + end end module m2 diff --git a/flang/test/Semantics/call03.f90 b/flang/test/Semantics/call03.f90 index 8f1be1ebff4eb..59513557324e5 100644 --- a/flang/test/Semantics/call03.f90 +++ b/flang/test/Semantics/call03.f90 @@ -386,7 +386,9 @@ subroutine test16() ! C1540 call contiguous(a) ! ok call pointer(a) ! ok call pointer(b) ! ok + !ERROR: VOLATILE target associated with non-VOLATILE pointer call pointer(c) ! ok + !ERROR: VOLATILE target associated with non-VOLATILE pointer call pointer(d) ! ok call valueassumedsize(a) ! ok call valueassumedsize(b) ! ok