[flang][Semantics][OpenMP] don't reduce variables in namelist (llvm#110671)

This is allowed by the OpenMP and F23 standards. But variables in a
namelist are not allowed in OpenMP privatisation. I suspect this was an
oversight.

If we allow this we run into problems masking the original symbol with
the symbol for the reduction variable when the variable is accessed via
a namelist initialised as a global variable. See llvm#101907. One solution
for this would be to force the namelist to always be initilized inside
of the block in which it is used (therefore using the correct mapping
for the reduction variable), but this could make some production
applications slow.

I tentatively think it is probably better to disallow a (perhaps
mistaken) edge case of the standards with (I think) little practical
use, than to make real applications slow in order to make this work. If
reviewers would rather keep to the letter of the standard, see llvm#109303
which implements the alternative solution. I'm open to either path
forward.

Fixes llvm#101907

Author: tblah

flang/lib/Semantics/check-namelist.cpp

@@ -34,4 +34,19 @@ void NamelistChecker::Leave(const parser::NamelistStmt &nmlStmt) {
   }
 }
 
+void NamelistChecker::Leave(const parser::LocalitySpec::Reduce &x) {
+  for (const parser::Name &name : std::get<std::list<parser::Name>>(x.t)) {
+    Symbol *sym{name.symbol};
+    // This is not disallowed by the standard, but would be difficult to
+    // support. This has to go here not with the other checks for locality specs
+    // in resolve-names.cpp so that it is done after the InNamelist flag is
+    // applied.
+    if (sym && sym->GetUltimate().test(Symbol::Flag::InNamelist)) {
+      context_.Say(name.source,
+          "NAMELIST variable '%s' not allowed in a REDUCE locality-spec"_err_en_US,
+          name.ToString());
+    }
+  }
+}
+
 } // namespace Fortran::semantics

flang/lib/Semantics/check-namelist.h

@@ -17,6 +17,7 @@ class NamelistChecker : public virtual BaseChecker {
 public:
   NamelistChecker(SemanticsContext &context) : context_{context} {}
   void Leave(const parser::NamelistStmt &);
+  void Leave(const parser::LocalitySpec::Reduce &);
 
 private:
   SemanticsContext &context_;

flang/lib/Semantics/resolve-directives.cpp

@@ -2384,6 +2384,21 @@ void OmpAttributeVisitor::ResolveOmpObject(
                               GetContext().directive)
                               .str()));
                 }
+                if (ompFlag == Symbol::Flag::OmpReduction) {
+                  const Symbol &ultimateSymbol{symbol->GetUltimate()};
+                  // Using variables inside of a namelist in OpenMP reductions
+                  // is allowed by the standard, but is not allowed for
+                  // privatisation. This looks like an oversight. If the
+                  // namelist is hoisted to a global, we cannot apply the
+                  // mapping for the reduction variable: resulting in incorrect
+                  // results. Disabling this hoisting could make some real
+                  // production code go slower. See discussion in #109303
+                  if (ultimateSymbol.test(Symbol::Flag::InNamelist)) {
+                    context_.Say(name->source,
+                        "Variable '%s' in NAMELIST cannot be in a REDUCTION clause"_err_en_US,
+                        name->ToString());
+                  }
+                }
                 if (GetContext().directive ==
                     llvm::omp::Directive::OMPD_target_data) {
                   checkExclusivelists(symbol, Symbol::Flag::OmpUseDevicePtr,

flang/test/Semantics/OpenMP/reduction-namelist.f90

@@ -0,0 +1,46 @@
+! RUN: %python %S/../test_errors.py %s %flang -fopenmp
+! This is not actually disallowed by the OpenMP standard, but it is not allowed
+! for privatisation - this seems like an oversight.
+
+module test
+  integer :: a, b, c
+  namelist /nlist1/ a, b
+end module
+
+program omp_reduction
+  use test
+
+  integer :: p(10) ,q(10)
+  namelist /nlist2/ c, d
+
+  a = 5
+  b = 10
+  c = 100
+
+  !ERROR: Variable 'd' in NAMELIST cannot be in a REDUCTION clause
+  !ERROR: Variable 'a' in NAMELIST cannot be in a REDUCTION clause
+  !$omp parallel reduction(+:d) reduction(+:a)
+  d = a + b
+  a = d
+  !$omp end parallel
+
+  call sb()
+
+  contains
+    subroutine sb()
+      namelist /nlist3/ p, q
+
+      !ERROR: Variable 'p' in NAMELIST cannot be in a REDUCTION clause
+      !ERROR: Variable 'q' in NAMELIST cannot be in a REDUCTION clause
+      !$omp parallel reduction(+:p) reduction(+:q)
+      p = c * b
+      q = p * d
+      !$omp end parallel
+
+      write(*, nlist1)
+      write(*, nlist2)
+      write(*, nlist3)
+
+    end subroutine
+
+end program omp_reduction

flang/test/Semantics/resolve123.f90

@@ -77,3 +77,13 @@ subroutine s9()
   do concurrent(i=1:5) reduce(+:i)
   end do
 end subroutine s9
+
+subroutine s10()
+! Cannot have variable inside of a NAMELIST in a REDUCE locality spec
+  integer :: k
+  namelist /nlist1/ k
+!ERROR: NAMELIST variable 'k' not allowed in a REDUCE locality-spec
+  do concurrent(i=1:5) reduce(+:k)
+     k = k + i
+  end do
+end subroutine s10