[flang-commits] [flang] 6b8e338 - [flang] Foil attempt to READ a NAMELIST with an undefinable member

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-08-08T11:56:59-07:00
New Revision: 6b8e33822ab3825f6d42b0c3e150b61e76cad5d6

URL: https://github.com/llvm/llvm-project/commit/6b8e33822ab3825f6d42b0c3e150b61e76cad5d6
DIFF: https://github.com/llvm/llvm-project/commit/6b8e33822ab3825f6d42b0c3e150b61e76cad5d6.diff

LOG: [flang] Foil attempt to READ a NAMELIST with an undefinable member

Detect and emit errors about undefinable NAMELIST group members in READ statements.

Fixes llvm-test-suite/Fortran/gfortran/regression/namelist_2.f90.

Differential Revision: https://reviews.llvm.org/D157344

Added: 
    

Modified: 
    flang/lib/Semantics/check-io.cpp
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/resolve40.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index 81b58a27deb9d6..5c4c9283bee691 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -1171,11 +1171,23 @@ parser::Message *IoChecker::CheckForBadIoType(const Symbol &symbol,
 
 void IoChecker::CheckNamelist(const Symbol &namelist, common::DefinedIo which,
     parser::CharBlock namelistLocation) const {
-  const auto &details{namelist.GetUltimate().get<NamelistDetails>()};
-  for (const Symbol &object : details.objects()) {
-    context_.CheckIndexVarRedefine(namelistLocation, object);
-    if (auto *msg{CheckForBadIoType(object, which, namelistLocation)}) {
-      evaluate::AttachDeclaration(*msg, namelist);
+  if (!context_.HasError(namelist)) {
+    const auto &details{namelist.GetUltimate().get<NamelistDetails>()};
+    for (const Symbol &object : details.objects()) {
+      context_.CheckIndexVarRedefine(namelistLocation, object);
+      if (auto *msg{CheckForBadIoType(object, which, namelistLocation)}) {
+        evaluate::AttachDeclaration(*msg, namelist);
+      } else if (which == common::DefinedIo::ReadFormatted) {
+        if (auto why{WhyNotDefinable(namelistLocation, namelist.owner(),
+                DefinabilityFlags{}, object)}) {
+          context_
+              .Say(namelistLocation,
+                  "NAMELIST input group must not contain undefinable item '%s'"_err_en_US,
+                  object.name())
+              .Attach(std::move(*why));
+          context_.SetError(namelist);
+        }
+      }
     }
   }
 }

diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index db3a68fbc0f65a..c22386ab83d9a2 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -5844,6 +5844,7 @@ void DeclarationVisitor::FinishNamelists() {
               ApplyImplicitRules(*symbol);
             } else if (!ConvertToObjectEntity(*symbol)) {
               SayWithDecl(name, *symbol, "'%s' is not a variable"_err_en_US);
+              context().SetError(*groupSymbol);
             }
             symbol->GetUltimate().set(Symbol::Flag::InNamelist);
             details->add_object(*symbol);

diff  --git a/flang/test/Semantics/resolve40.f90 b/flang/test/Semantics/resolve40.f90
index 310b3c3872a0f8..b3384a91097d7f 100644
--- a/flang/test/Semantics/resolve40.f90
+++ b/flang/test/Semantics/resolve40.f90
@@ -88,3 +88,11 @@ subroutine s11
   integer :: nl3
   nl2 = 1
 end
+
+subroutine s12(x)
+  real, intent(in) :: x
+  namelist /nl/x
+  !ERROR: NAMELIST input group must not contain undefinable item 'x'
+  !BECAUSE: 'x' is an INTENT(IN) dummy argument
+  read(*,nml=nl)
+end