Fix Issue #3135 - Also add tests to check that emitter is properly processing interface module declarations

6 files changed, 239 insertions, 3 deletions

diff --git a/src/CHANGES.txt b/src/CHANGES.txt
index 4d24611..98a414e 100755
--- a/src/CHANGES.txt
+++ b/src/CHANGES.txt
@@ -18,6 +18,9 @@ RELEASE  VERSION/DATE TO BE FILLED IN LATER
       Decider and not clearing it when the configure context is completed.
     - Add default paths for yacc tool on windows to include cygwin, mingw, and chocolatey
 
+  From Github User pdiener:
+    - Fix issue #3135 - Handle Fortran submodules and type bound procedures
+
   From Daniel Moody:
     - Change the default for AppendENVPath to delete_existing=0, so path
       order will not be changed, unless explicitly set (Issue #3276)
diff --git a/src/engine/SCons/Scanner/FortranTests.py b/src/engine/SCons/Scanner/FortranTests.py
index 2e10473..c958474 100644
--- a/src/engine/SCons/Scanner/FortranTests.py
+++ b/src/engine/SCons/Scanner/FortranTests.py
@@ -363,9 +363,9 @@ class FortranScannerTestCase9(unittest.TestCase):
 
         n = env.File('fff3.f')
 
-        def my_rexists(s1):
-            s1.Tag('rexists_called', 1)
-            return SCons.Node._rexists_map[s.GetTag('old_rexists')](s1)
+        def my_rexists(s):
+            s.Tag('rexists_called', 1)
+            return SCons.Node._rexists_map[s.GetTag('old_rexists')](s)
 
         n.Tag('old_rexists', n._func_rexists)
         SCons.Node._rexists_map[3] = my_rexists
@@ -530,6 +530,7 @@ class FortranScannerTestCase16(unittest.TestCase):
         test.unlink('f10.f')
 
 
+
 if __name__ == "__main__":
     unittest.main()
 
diff --git a/src/engine/SCons/Tool/FortranCommonTests.py b/src/engine/SCons/Tool/FortranCommonTests.py
new file mode 100644
index 0000000..6ccd206
--- /dev/null
+++ b/src/engine/SCons/Tool/FortranCommonTests.py
@@ -0,0 +1,125 @@
+#
+# __COPYRIGHT__
+#
+# Permission is hereby granted, free of charge, to any person obtaining
+# a copy of this software and associated documentation files (the
+# "Software"), to deal in the Software without restriction, including
+# without limitation the rights to use, copy, modify, merge, publish,
+# distribute, sublicense, and/or sell copies of the Software, and to
+# permit persons to whom the Software is furnished to do so, subject to
+# the following conditions:
+#
+# The above copyright notice and this permission notice shall be included
+# in all copies or substantial portions of the Software.
+#
+# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY
+# KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
+# WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+# LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+# OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+# WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+#
+# from typing import Dict, Any
+
+__revision__ = "__FILE__ __REVISION__ __DATE__ __DEVELOPER__"
+
+import os
+import os.path
+import unittest
+
+import SCons.Node.FS
+import SCons.Warnings
+import SCons.Tool.FortranCommon
+
+import TestCmd
+
+original = os.getcwd()
+
+test = TestCmd.TestCmd(workdir='')
+
+os.chdir(test.workpath(''))
+
+
+class DummyEnvironment(object):
+    dictionary = None  # type: Dict[Any, Any]
+
+    def __init__(self, list_cpp_path):
+        self.path = list_cpp_path
+        self.fs = SCons.Node.FS.FS(test.workpath(''))
+        self.dictionary = {}
+
+    def has_key(self, key):
+        return key in self.dictionary
+
+    def __getitem__(self, key):
+        return self.dictionary[key]
+
+    def __setitem__(self, key, value):
+        self.dictionary[key] = value
+
+    def __delitem__(self, key):
+        del self.dictionary[key]
+
+    def subst(self, arg, target=None, source=None, conv=None):
+        if arg[0] == '$':
+            return self[arg[1:]]
+        return arg
+
+    def subst_path(self, path, target=None, source=None, conv=None):
+        if not isinstance(path, list):
+            path = [path]
+        return list(map(self.subst, path))
+
+    def get_calculator(self):
+        return None
+
+    def get_factory(self, factory):
+        return factory or self.fs.File
+
+    def Dir(self, filename):
+        return self.fs.Dir(filename)
+
+    def File(self, filename):
+        return self.fs.File(filename)
+
+
+class FortranScannerSubmodulesTestCase(unittest.TestCase):
+    def runTest(self):
+        """
+        Check that test_1.f90 and test_2.f90 which have interface specifications
+        Don't generate targets for those modules listed in the interface section
+        """
+
+        test.dir_fixture('fortran_unittests')
+        env = DummyEnvironment([test.workpath('modules')])
+        env['FORTRANMODDIR'] = 'modules'
+        env['FORTRANMODSUFFIX'] = '.mod'
+        emitter = SCons.Tool.FortranCommon._fortranEmitter
+        # path = s.path(env)
+
+        for fort in ['test_1.f90', 'test_2.f90']:
+            file_base, _ = os.path.splitext(fort)
+            file_mod = '%s.mod' % file_base
+            f = env.File(fort)
+            (target, source) = emitter([], [f, ], env)
+
+            # print("Targets:%s\nSources:%s"%([str(a) for a in target], [str(a) for a in source]))
+
+            # should only be 1 target and 1 source
+            self.assertEqual(len(target), 1,
+                             msg="More than 1 target: %d [%s]" % (len(target), [str(t) for t in target]))
+            self.assertEqual(len(source), 1,
+                             msg="More than 1 source: %d [%s]" % (len(source), [str(t) for t in source]))
+
+            # target should be file_base.mod
+            self.assertEqual(str(target[0]).endswith(file_mod), True,
+                             msg="Target[0]=%s doesn't end with '%s'" % (str(target[0]), file_mod))
+
+            # source should be file_base .f90
+            self.assertEqual(str(source[0]).endswith(fort), True,
+                             msg="Source[0]=%s doesn't end with '%s'" % (str(source[0]), fort))
+
+
+if __name__ == "__main__":
+    unittest.main()
diff --git a/test/fixture/fortran_unittests/test_1.f90 b/test/fixture/fortran_unittests/test_1.f90
new file mode 100644
index 0000000..25ba9d6
--- /dev/null
+++ b/test/fixture/fortran_unittests/test_1.f90
@@ -0,0 +1,46 @@
+module test_1
+
+  type test_type_1
+    integer :: n
+    contains
+      procedure :: set_n
+      procedure :: get_n
+  end type test_type_1
+
+
+interface
+
+  module subroutine set_n ( this, n )
+    class(test_type_1), intent(inout) :: this
+    integer, intent(in) :: n
+  end subroutine
+
+  module function get_n ( this )
+    class(test_type_1), intent(in) :: this
+    integer :: get_n
+  end function get_n
+
+end interface
+
+end module test_1
+
+
+submodule(test_1) test_1_impl
+
+contains
+
+  module procedure set_n
+
+    implicit none
+
+    this%n = n
+  end procedure set_n
+
+  module procedure get_n
+
+    implicit none
+
+    get_n = this%n
+  end procedure get_n
+
+end submodule test_1_impl
diff --git a/test/fixture/fortran_unittests/test_2.f90 b/test/fixture/fortran_unittests/test_2.f90
new file mode 100644
index 0000000..7a39b0d
--- /dev/null
+++ b/test/fixture/fortran_unittests/test_2.f90
@@ -0,0 +1,46 @@
+module test_2
+
+  type test_type_2
+    integer :: m
+    contains
+      procedure :: set_m
+      procedure :: get_m
+  end type test_type_2
+
+
+interface
+
+  module subroutine set_m ( this, m )
+    class(test_type_2), intent(inout) :: this
+    integer, intent(in) :: m
+  end subroutine
+
+  module function get_m ( this )
+    class(test_type_2), intent(in) :: this
+    integer :: get_m
+  end function get_m
+
+end interface
+
+end module test_2
+
+
+submodule(test_2) test_2_impl
+
+contains
+
+  module procedure set_m
+
+    implicit none
+
+    this%m = m
+  end procedure set_m
+
+  module procedure get_m
+
+    implicit none
+
+    get_m = this%m
+  end procedure get_m
+
+end submodule test_2_impl
diff --git a/test/fixture/fortran_unittests/test_submodules.f90 b/test/fixture/fortran_unittests/test_submodules.f90
new file mode 100644
index 0000000..5deec37
--- /dev/null
+++ b/test/fixture/fortran_unittests/test_submodules.f90
@@ -0,0 +1,15 @@
+program test_submodules
+
+  use test_1
+  use test_2
+
+  type(test_type_1) :: var1
+  type(test_type_2) :: var2
+
+  call var1%set_n(42)
+  call var2%set_m(21)
+
+  print*,'var1%n = ', var1%get_n()
+  print*,'var2%m = ', var2%get_m()
+
+end program test_submodules