Merge pull request #3359 from bdbaddog/fortran_issue_3135

Fix Issue #3135 - Type Bound procedures in Fortran submodules

3 files changed, 165 insertions, 0 deletions

diff --git a/test/fixture/fortran_unittests/test_1.f90 b/test/fixture/fortran_unittests/test_1.f90
new file mode 100644
index 0000000..50ab99e
--- /dev/null
+++ b/test/fixture/fortran_unittests/test_1.f90
@@ -0,0 +1,68 @@
+module test_1
+
+  type test_type_1
+    integer :: n
+    contains
+      procedure :: set_n
+      procedure :: get_n
+      procedure :: increment_n
+      procedure :: decrement_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
+
+  module pure subroutine increment_n ( this )
+    class(test_type_1), intent(inout) :: this
+  end subroutine increment_n
+
+  module elemental subroutine decrement_n ( this )
+    class(test_type_1), intent(inout) :: this
+  end subroutine decrement_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
+
+  module pure subroutine increment_n ( this )
+    class(test_type_1), intent(inout) :: this
+
+    this%n = this%n+1
+  end subroutine increment_n
+
+  module elemental subroutine decrement_n ( this )
+    class(test_type_1), intent(inout) :: this
+
+    this%n = this%n-1
+  end subroutine decrement_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..e271953
--- /dev/null
+++ b/test/fixture/fortran_unittests/test_2.f90
@@ -0,0 +1,70 @@
+module test_2
+
+  type test_type_2
+    integer :: m
+    contains
+      procedure :: set_m
+      procedure :: get_m
+      procedure :: increment_m
+      procedure :: decrement_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
+
+  module pure subroutine increment_m ( this )
+    class(test_type_2), intent(inout) :: this
+  end subroutine increment_m
+
+  module elemental subroutine decrement_m ( this )
+    class(test_type_2), intent(inout) :: this
+  end subroutine decrement_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
+
+  module procedure increment_m
+
+    implicit none
+
+    this%m = this%m+1
+  end procedure increment_m
+
+  module procedure decrement_m
+
+    implicit none
+
+    this%m = this%m-1
+  end procedure decrement_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..08e472c
--- /dev/null
+++ b/test/fixture/fortran_unittests/test_submodules.f90
@@ -0,0 +1,27 @@
+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()
+
+  call var1%increment_n()
+  call var2%increment_m()
+
+  print*,'var1%n = ', var1%get_n()
+  print*,'var2%m = ', var2%get_m()
+
+  call var1%decrement_n()
+  call var2%decrement_m()
+
+  print*,'var1%n = ', var1%get_n()
+  print*,'var2%m = ', var2%get_m()
+
+end program test_submodules