[flang-commits] [flang] [flang] Fix inheritance of IMPLICIT typing rules (PR #102692)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

Interfaces don't inherit the IMPLICIT typing rules of their enclosing scope, and separate MODULE PROCEDUREs inherit the IMPLICIT typing rules of submodule in which they are defined, not the rules from their interface.

Fixes https://github.com/llvm/llvm-project/issues/102558.

---
Full diff: https://github.com/llvm/llvm-project/pull/102692.diff


2 Files Affected:

- (modified) flang/lib/Semantics/resolve-names.cpp (+6-6) 
- (added) flang/test/Semantics/implicit15.f90 (+50) 


``````````diff
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index b4875d87d172c..c0478fd439007 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -62,10 +62,9 @@ class ScopeHandler;
 // When inheritFromParent is set, defaults come from the parent rules.
 class ImplicitRules {
 public:
-  ImplicitRules(SemanticsContext &context, ImplicitRules *parent)
-      : parent_{parent}, context_{context} {
-    inheritFromParent_ = parent != nullptr;
-  }
+  ImplicitRules(SemanticsContext &context, const ImplicitRules *parent)
+      : parent_{parent}, context_{context},
+        inheritFromParent_{parent != nullptr} {}
   bool isImplicitNoneType() const;
   bool isImplicitNoneExternal() const;
   void set_isImplicitNoneType(bool x) { isImplicitNoneType_ = x; }
@@ -82,7 +81,7 @@ class ImplicitRules {
 private:
   static char Incr(char ch);
 
-  ImplicitRules *parent_;
+  const ImplicitRules *parent_;
   SemanticsContext &context_;
   bool inheritFromParent_{false}; // look in parent if not specified here
   bool isImplicitNoneType_{
@@ -3380,6 +3379,7 @@ bool ModuleVisitor::BeginSubmodule(
     parentScope = &currScope();
   }
   BeginModule(name, true);
+  set_inheritFromParent(false); // submodules don't inherit parents' implicits
   if (ancestor && !ancestor->AddSubmodule(name.source, currScope())) {
     Say(name, "Module '%s' already has a submodule named '%s'"_err_en_US,
         ancestorName.source, name.source);
@@ -4487,7 +4487,7 @@ Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
         CHECK(context().HasError(genericSymbol));
       }
     }
-    set_inheritFromParent(hasModulePrefix);
+    set_inheritFromParent(false); // interfaces don't inherit, even if MODULE
   }
   if (Symbol * found{FindSymbol(name)};
       found && found->has<HostAssocDetails>()) {
diff --git a/flang/test/Semantics/implicit15.f90 b/flang/test/Semantics/implicit15.f90
new file mode 100644
index 0000000000000..d7cfa543e84a5
--- /dev/null
+++ b/flang/test/Semantics/implicit15.f90
@@ -0,0 +1,50 @@
+!RUN: %flang_fc1 -fdebug-unparse  %s  2>&1 | FileCheck %s
+!Test inheritance of implicit rules in submodules and separate module
+!procedures.
+
+module m
+  implicit integer(1)(a-z)
+  interface
+    module subroutine mp(da) ! integer(2)
+      implicit integer(2)(a-z)
+    end
+  end interface
+  save :: mv ! integer(1)
+end
+
+submodule(m) sm1
+  implicit integer(8)(a-z)
+  save :: sm1v ! integer(8)
+  interface
+    module subroutine sm1p(da) ! default real
+    end
+  end interface
+end
+
+submodule(m:sm1) sm2
+  implicit integer(2)(a-c,e-z)
+  save :: sm2v ! integer(2)
+ contains
+  module subroutine sm1p(da) ! default real
+    save :: sm1pv ! inherited integer(2)
+    !CHECK: PRINT *, 1_4, 8_4, 2_4, 4_4, 2_4
+    print *, kind(mv), kind(sm1v), kind(sm2v), kind(da), kind(sm1pv)
+  end
+end
+
+submodule(m:sm2) sm3
+  implicit integer(8)(a-z)
+  save :: sm3v ! integer(8)
+ contains
+  module procedure mp
+    save :: mpv ! inherited integer(8)
+    call sm1p(1.)
+    !CHECK: PRINT *, 1_4, 8_4, 2_4, 8_4, 2_4, 8_4
+    print *, kind(mv), kind(sm1v), kind(sm2v), kind(sm3v), kind(da), kind(mpv)
+  end
+end
+
+program main
+  use m
+  call mp(1_2)
+end

``````````

</details>


https://github.com/llvm/llvm-project/pull/102692