[flang] Fix for flang-compiler/f18#694 - Unexpected error when compiling submodule

Change-Id: I03939bfc705cc5319a0b7da3305026b8403b8edc

Original-commit: flang-compiler/f18@e1237939aa
Reviewed-on: https://github.com/flang-compiler/f18/pull/817
Tree-same-pre-rewrite: false

flang/lib/semantics/resolve-names.cc

@@ -2801,15 +2801,32 @@ bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
   return true;
 }
 
+// A subprogram declared with SUBROUTINE or function
+// If the subprogram is not in interface block, check if its declared as separate 
+// module procedures
 bool SubprogramVisitor::BeginSubprogram(
     const parser::Name &name, Symbol::Flag subpFlag, bool hasModulePrefix) {
+  bool isSeparateModuleProc = false;
+  // Check if Subprogram has Module Prefix and Subprogram is not inside Interface Block 
   if (hasModulePrefix && !inInterfaceBlock()) {
-    Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
-    return false;
+    // Check if the Subprogram is declared as separate module procedures
+    auto *symbol{FindSymbol(name)};
+    if (symbol && symbol->has<SubprogramNameDetails>()) {
+      symbol = FindSymbol(currScope().parent(), name);
+    }
+    if (symbol)
+      isSeparateModuleProc = symbol->IsSeparateModuleProc();
+
+    // Issue error: Subprogram is not declared as separate module procedure
+    if (!isSeparateModuleProc) {
+      Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
+      return false;
+    }
   }
   PushSubprogramScope(name, subpFlag);
   return true;
 }
+
 void SubprogramVisitor::EndSubprogram() { PopScope(); }
 
 Symbol &SubprogramVisitor::PushSubprogramScope(

flang/test/semantics/CMakeLists.txt

@@ -186,6 +186,7 @@ set(ERROR_TESTS
   call13.f90
   call14.f90
   misc-declarations.f90
+  separate_module_procs_2.f90
 )
 
 # These test files have expected symbols in the source
@@ -214,6 +215,7 @@ set(SYMBOL_TESTS
   kinds01.f90
   kinds03.f90
   procinterface01.f90
+  separate_module_procs_1.f90
 )
 
 # These test files have expected .mod file contents in the source

flang/test/semantics/separate_module_procs_1.f90

@@ -0,0 +1,61 @@
+! Copyright (c) 2018, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+!DEF: /m1 Module
+module m1
+  !DEF: /m1/ma PUBLIC (Function) Generic
+  interface ma
+    !DEF: /m1/ma_create_fun MODULE, PUBLIC (Function) Subprogram INTEGER(4)
+    !DEF: /m1/ma_create_fun/this ObjectEntity INTEGER(4)
+    module function ma_create_fun( ) result(this)
+      !REF: /m1/ma_create_fun/this
+      integer this
+    end function
+  end interface
+end module
+
+!REF: /m1
+!DEF: /m1/ma_submodule Module
+submodule (m1) ma_submodule
+  contains
+  !DEF: /m1/ma_submodule/ma_create_fun MODULE, PUBLIC (Function) Subprogram INTEGER(4)
+  !DEF: /m1/ma_submodule/ma_create_fun/this ObjectEntity INTEGER(4)
+  module function ma_create_fun() result(this)
+    !REF: /m1/ma_submodule/ma_create_fun/this
+    integer this
+    print *, "Hello"
+  end function
+end submodule
+
+!DEF: /m2 Module
+module m2
+  !DEF: /m2/mb PUBLIC (Subroutine) Generic
+  interface mb
+    !DEF: /m2/mb_create_sub MODULE, PUBLIC (Subroutine) Subprogram
+    module subroutine  mb_create_sub
+    end subroutine mb_create_sub
+  end interface
+end module
+
+!REF: /m2
+!DEF: /m2/mb_submodule Module
+submodule (m2) mb_submodule
+  contains
+  !DEF: /m2/mb_submodule/mb_create_sub MODULE, PUBLIC (Subroutine) Subprogram
+  module subroutine  mb_create_sub
+    !DEF: /m2/mb_submodule/mb_create_sub/this ObjectEntity INTEGER(4)
+    integer this
+    print *, "Hello"
+  end subroutine mb_create_sub
+end submodule

flang/test/semantics/separate_module_procs_2.f90

@@ -0,0 +1,41 @@
+! Copyright (c) 2018, NVIDIA CORPORATION.  All rights reserved.
+!
+! Licensed under the Apache License, Version 2.0 (the "License");
+! you may not use this file except in compliance with the License.
+! You may obtain a copy of the License at
+!
+!     http://www.apache.org/licenses/LICENSE-2.0
+!
+! Unless required by applicable law or agreed to in writing, software
+! distributed under the License is distributed on an "AS IS" BASIS,
+! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+! See the License for the specific language governing permissions and
+! limitations under the License.
+
+module m1
+  interface ma
+  end interface
+end module
+
+submodule (m1) ma_submodule
+  contains
+  !ERROR: 'ma_create_new_fun' was not declared a separate module procedure
+  module function ma_create_new_fun() result(this)
+    integer :: this
+    print *, "Hello"
+  end function
+end submodule
+
+module m2
+  interface mb
+  end interface
+end module
+
+submodule (m2) mb_submodule
+  contains
+  !ERROR: 'mb_create_new_sub' was not declared a separate module procedure
+  module SUBROUTINE  mb_create_new_sub() 
+    integer :: this
+    print *, "Hello"
+  end SUBROUTINE mb_create_new_sub
+end submodule