[Bug fortran/52846] [F2008] Support submodules

[pault at gcc dot gnu.org]

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
!_________________________________________________________________________________!