https://gcc.gnu.org/bugzilla/show_bug.cgi?id=52846
--- Comment #4 from Paul Thomas <pault at gcc dot gnu.org> --- Testcase: ! Test vehicle for submodules ! 14th June 2015 ! ! Paul Thomas - check1406b.diff applies ! ! FIXED OR MOSTLY FIXED: ! Access in submodules to PROCEDURE COMPONENTS - FIXED 06/06/2015 ! MODULE FUNCTIONS - partially FIXED 10/06/15 - syntax errors give difficult to understand messages ! Salvatore's submodbug fixed 10/06/15 - module variable must remain use associated ! Name mangling of MODULE PROCEDUREs - FIXED 13/06 ! Parsing of SUBMODULE (module:parent_submodule:.....) - already worked(!) tested 14/06 ! Checking characteristics between interface and submodule declaration - FIXED 14/06 ! ! TODOs: ! Clean up and comment all the new code (Partially done 14/06) ! Prepare testcases for testsuite ! Constraints as delineated in N1602.pdf or F2008 standard (will have to check what is left!) ! Restricting output of .mod file from submodules to local symbols, etc. only (not essential) ! Prepare ChangeLogs ! Submit :-) ! module foo_interface implicit none type foo character(len=15) :: greeting = "Hello, world! " contains procedure :: greet => say_hello procedure :: farewell => bye end type foo interface module subroutine say_hello(this) import foo class(foo), intent(in) :: this end subroutine module subroutine bye(this) import foo class(foo), intent(in) :: this end subroutine module function realf (arg) result (res) real :: arg, res end function integer module function intf (arg) integer :: arg end function real module function realg (arg) real :: arg end function integer module function intg (arg) integer :: arg end function end interface contains subroutine smurf class(foo), allocatable :: this allocate (this) print *, "say_hello from SMURF --->" ! Test that say_hello is effectively host associated call say_hello (this) end subroutine end module !_________________________________________________________________________________! SUBMODULE (foo_interface) foo_interface_son ! contains ! Test module procedure with conventional specification part for dummies module subroutine say_hello(this) class(foo), intent(in) :: this class(foo), allocatable :: that allocate (that, source = this) ! Test that components of foo are accessible print *, "(say_hello)", that%greeting ! call this%farewell ! NOTE WELL: This compiles and causes a crash in run-time ! due to recursion through the call to this procedure from ! say hello. end subroutine module function realf (arg) result (res) real :: arg, res res = 2*arg end function end SUBMODULE foo_interface_son !_________________________________________________________________________________! ! Check that multiple generations of submodules are OK SUBMODULE (foo_interface:foo_interface_son) foo_interface_grandson ! contains integer module function intf (arg) integer :: arg intf = 2*arg end function end SUBMODULE foo_interface_grandson !_________________________________________________________________________________! SUBMODULE (foo_interface) foo_interface_daughter ! contains ! Test module procedure with abbreviated declaration and no specification of dummies module procedure bye ! Verify the derived type foo is accessible - had problems with this because if_source != IFSRC_DECL class(foo), allocatable :: that print *, "(bye) ", this%greeting print *, "say_hello from BYE --->" call say_hello (this) allocate (that, source = this) ! Test that components of foo are accessible print *, "(bye)", that%greeting print *, "call that%greet from BYE --->" call that%greet end subroutine module procedure intg intg = 3*arg end function module procedure realg realg = 3*arg end function end SUBMODULE foo_interface_daughter !_________________________________________________________________________________! program try use foo_interface implicit none type(foo) :: bar call bar%greet ! typebound call ! Unnecessary tests at present ! bar%greeting = "Goodbye, world!" ! call bar%greet ! typebound call with changed message print *, "say_hello from TRY --->" call say_hello(bar) ! Checks use association of 'say_hello' call bye(bar) ! Checks use association in another submodule call smurf ! Checks host association of 'say_hello' bar%greeting = "farewell " call bar%farewell print *, realf(2.0) ! Check module procedure with explicit result print *, intf(2) ! ditto print *, realg(3.0) ! Check module procedure with function declaration result print *, intg(3) ! ditto end program !_________________________________________________________________________________!