[flang-commits] [flang] 078b1c4 - [flang] Don't complain about implicitly-typed dummy arguments inherited into an IMPLICIT NONE submodule

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-08-08T10:48:54-07:00
New Revision: 078b1c42f6c8bdad8aea2b99ac4b4ac79ca5665c

URL: https://github.com/llvm/llvm-project/commit/078b1c42f6c8bdad8aea2b99ac4b4ac79ca5665c
DIFF: https://github.com/llvm/llvm-project/commit/078b1c42f6c8bdad8aea2b99ac4b4ac79ca5665c.diff

LOG: [flang] Don't complain about implicitly-typed dummy arguments inherited into an IMPLICIT NONE submodule

When a module procedure's interface is defined in an ancestor (sub)module
with an implicitly typed dummy argument, don't emit a bogus error in
the separate module procedure later if its submodule has IMPLICIT NONE.

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

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

Added: 
    flang/test/Semantics/modproc02.f90

Modified: 
    flang/lib/Semantics/resolve-names-utils.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index c3be572bf51f1c..2f8e5777c52902 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -917,6 +917,7 @@ void MapSubprogramToNewSymbols(const Symbol &oldSymbol, Symbol &newSymbol,
     if (!dummyArg) {
       newDetails.add_alternateReturn();
     } else if (Symbol *copy{newScope.CopySymbol(*dummyArg)}) {
+      copy->set(Symbol::Flag::Implicit, false);
       newDetails.add_dummyArg(*copy);
       mappings->symbolMap[dummyArg] = copy;
     }

diff  --git a/flang/test/Semantics/modproc02.f90 b/flang/test/Semantics/modproc02.f90
new file mode 100644
index 00000000000000..229ef72e6bcf04
--- /dev/null
+++ b/flang/test/Semantics/modproc02.f90
@@ -0,0 +1,27 @@
+!RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s
+module m
+  interface
+    module subroutine s(x) ! implicitly typed
+    end
+  end interface
+end
+
+submodule (m) sm
+  implicit none
+ contains
+  !Ensure no error here due to IMPLICIT NONE
+  module procedure s
+  end
+end
+
+!CHECK:  Module scope: m size=0 alignment=1 sourceRange=63 bytes
+!CHECK:    s, MODULE, PUBLIC (Subroutine): Subprogram isInterface (REAL(4) x)
+!CHECK:    sm: Module (m)
+!CHECK:    Subprogram scope: s size=4 alignment=4 sourceRange=26 bytes
+!CHECK:      s (Subroutine): HostAssoc
+!CHECK:      x (Implicit) size=4 offset=0: ObjectEntity dummy type: REAL(4)
+!CHECK:    Module scope: sm size=0 alignment=1 sourceRange=65 bytes
+!CHECK:      s, MODULE, PUBLIC (Subroutine): Subprogram (REAL(4) x) moduleInterface: s, MODULE, PUBLIC (Subroutine): Subprogram isInterface (REAL(4) x)
+!CHECK:      Subprogram scope: s size=4 alignment=4 sourceRange=22 bytes
+!CHECK:        s: HostAssoc
+!CHECK:        x size=4 offset=0: ObjectEntity dummy type: REAL(4)