[flang] Fix scope in which undeclared symbols are created

Don't create new symbols in FORALL, implied DO, or other
construct scopes when an undeclared name appears; use the
innermost enclosing program unit's scope.  This clears up
a pending TODO in name resolution, and also exposes (& fixes)
an unnoticed name resolution problem in a module file test.

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

Author: klausler

flang/lib/Semantics/resolve-names.cpp

@@ -459,9 +459,8 @@ class ScopeHandler : public ImplicitRulesVisitor {
   Scope &currScope() { return DEREF(currScope_); }
   // The enclosing host procedure if current scope is in an internal procedure
   Scope *GetHostProcedure();
-  // The enclosing scope, skipping blocks and derived types.
-  // TODO: Will return the scope of a FORALL or implied DO loop; is this ok?
-  // If not, should call FindProgramUnitContaining() instead.
+  // The innermost enclosing program unit scope, ignoring BLOCK and other
+  // construct scopes.
   Scope &InclusiveScope();
   // The enclosing scope, skipping derived types.
   Scope &NonDerivedTypeScope();
@@ -2015,12 +2014,21 @@ void ScopeHandler::Say2(const parser::Name &name, MessageFixedText &&msg1,
   context().SetError(symbol, msg1.isFatal());
 }
 
-// T may be `Scope` or `const Scope`
+// This is essentially GetProgramUnitContaining(), but it can return
+// a mutable Scope &, it ignores statement functions, and it fails
+// gracefully for error recovery (returning the original Scope).
 template <typename T> static T &GetInclusiveScope(T &scope) {
   for (T *s{&scope}; !s->IsGlobal(); s = &s->parent()) {
-    if (s->kind() != Scope::Kind::Block && !s->IsDerivedType() &&
-        !s->IsStmtFunction()) {
-      return *s;
+    switch (s->kind()) {
+    case Scope::Kind::Module:
+    case Scope::Kind::MainProgram:
+    case Scope::Kind::Subprogram:
+    case Scope::Kind::BlockData:
+      if (!s->IsStmtFunction()) {
+        return *s;
+      }
+      break;
+    default:;
     }
   }
   return scope;

flang/test/Semantics/modfile26.f90

@@ -71,13 +71,15 @@ end module m1
 !intrinsic::all
 !integer(4),parameter::intpvals(1_8:*)=[INTEGER(4)::0_4,2_4,3_4,4_4,5_4,9_4,10_4,18_4,19_4,38_4,39_4]
 !integer(4),parameter::intpkinds(1_8:*)=[INTEGER(4)::1_4,1_4,2_4,2_4,4_4,4_4,8_4,8_4,16_4,16_4,-1_4]
+!intrinsic::selected_int_kind
 !intrinsic::size
 !logical(4),parameter::ipcheck=.true._4
 !integer(4),parameter::realprecs(1_8:*)=[INTEGER(4)::3_4,2_4,6_4,15_4,18_4,33_4]
 !intrinsic::precision
 !logical(4),parameter::rpreccheck=.true._4
 !integer(4),parameter::realpvals(1_8:*)=[INTEGER(4)::0_4,3_4,4_4,6_4,7_4,15_4,16_4,18_4,19_4,33_4,34_4]
 !integer(4),parameter::realpkinds(1_8:*)=[INTEGER(4)::2_4,2_4,4_4,4_4,8_4,8_4,10_4,10_4,16_4,16_4,-1_4]
+!intrinsic::selected_real_kind
 !logical(4),parameter::realpcheck=.true._4
 !integer(4),parameter::realranges(1_8:*)=[INTEGER(4)::4_4,37_4,37_4,307_4,4931_4,4931_4]
 !logical(4),parameter::rrangecheck=.true._4