From: Paul Thomas Date: Fri, 17 Jul 2015 17:24:32 +0000 (+0000) Subject: re PR fortran/52846 ([F2008] Support submodules) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=09155f6980eb9dcd6bd2c5d10be8c8a4fde89394;p=gcc.git re PR fortran/52846 ([F2008] Support submodules) 2015-07-17 Paul Thomas PR fortran/52846 * decl.c (gfc_match_end): Pick out declared submodule name from the composite identifier. * gfortran.h : Add 'submodule_name' to gfc_use_list structure. * module.c (gfc_match_submodule): Define submodule_name and add static 'submodule_name'. (gfc_match_submodule): Build up submodule filenames, using '@' as a delimiter. Store the output filename in 'submodule_name'. Similarly, the submodule identifier is built using '.' as an identifier. (gfc_dump_module): If current state is COMP_SUBMODULE, write to file 'submodule_name', using SUBMODULE_EXTENSION. (gfc_use_module): Similarly, use the 'submodule_name' field in the gfc_use_list structure and SUBMODULE_EXTENSION to read the implicitly used submodule files. 2015-07-17 Paul Thomas PR fortran/52846 * lib/fortran-modules.exp (proc cleanup-submodules): New procedure. * gfortran.dg/submodule_1.f08: Change extension and clean up the submodule files. * gfortran.dg/submodule_2.f08: ditto * gfortran.dg/submodule_6.f08: ditto * gfortran.dg/submodule_7.f08: ditto * gfortran.dg/submodule_8.f08: New test * gfortran.dg/submodule_9.f08: New test From-SVN: r225946 --- diff --git a/gcc/testsuite/gfortran.dg/submodule_2.f08 b/gcc/testsuite/gfortran.dg/submodule_2.f08 new file mode 100644 index 00000000000..60925ec788d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/submodule_2.f08 @@ -0,0 +1,102 @@ +! { dg-do run } +! +! Test dummy and result arrays in module procedures +! +! Contributed by Paul Thomas +! + module foo_interface + implicit none + type foo + character(len=16) :: greeting = "Hello, world! " + character(len=16), private :: byebye = "adieu, world! " + end type foo + + interface + module function array1(this) result (that) + type(foo), intent(in), dimension(:) :: this + type(foo), allocatable, dimension(:) :: that + end function + character(16) module function array2(this, that) + type(foo), intent(in), dimension(:) :: this + type(foo), allocatable, dimension(:) :: that + end function + module subroutine array3(this, that) + type(foo), intent(in), dimension(:) :: this + type(foo), intent(inOUT), allocatable, dimension(:) :: that + end subroutine + module subroutine array4(this, that) + type(foo), intent(in), dimension(:) :: this + type(foo), intent(inOUT), allocatable, dimension(:) :: that + end subroutine + end interface + end module + +! + SUBMODULE (foo_interface) foo_interface_son +! + contains + +! Test array characteristics for dummy and result are OK + module function array1 (this) result(that) + type(foo), intent(in), dimension(:) :: this + type(foo), allocatable, dimension(:) :: that + allocate (that(size(this)), source = this) + that%greeting = that%byebye + end function + +! Test array characteristics for dummy and result are OK for +! abbreviated module procedure declaration. + module procedure array2 + allocate (that(size(this)), source = this) + that%greeting = that%byebye + array2 = trim (that(size (that))%greeting(1:5))//", people!" + end PROCEDURE + + end SUBMODULE foo_interface_son + +! + SUBMODULE (foo_interface) foo_interface_daughter +! + contains + +! Test array characteristics for dummies are OK + module subroutine array3(this, that) + type(foo), intent(in), dimension(:) :: this + type(foo), intent(inOUT), allocatable, dimension(:) :: that + allocate (that(size(this)), source = this) + that%greeting = that%byebye + end subroutine + +! Test array characteristics for dummies are OK for +! abbreviated module procedure declaration. + module procedure array4 + integer :: i + allocate (that(size(this)), source = this) + that%greeting = that%byebye + do i = 1, size (that) + that(i)%greeting = trim (that(i)%greeting(1:5))//", people!" + end do + end PROCEDURE + end SUBMODULE foo_interface_daughter + +! + program try + use foo_interface + implicit none + type(foo), dimension(2) :: bar + type (foo), dimension(:), allocatable :: arg + + arg = array1(bar) ! typebound call + if (any (arg%greeting .ne. ["adieu, world! ", "adieu, world! "])) call abort + deallocate (arg) + if (trim (array2 (bar, arg)) .ne. "adieu, people!") call abort + deallocate (arg) + call array3 (bar, arg) ! typebound call + if (any (arg%greeting .ne. ["adieu, world! ", "adieu, world! "])) call abort + deallocate (arg) + call array4 (bar, arg) ! typebound call + if (any (arg%greeting .ne. ["adieu, people!", "adieu, people!"])) call abort + contains + end program +! { dg-final { cleanup-submodules "foo_interface@foo_interface_son" } } +! { dg-final { cleanup-submodules "foo_interface@foo_interface_daughter" } } diff --git a/gcc/testsuite/gfortran.dg/submodule_2.f90 b/gcc/testsuite/gfortran.dg/submodule_2.f90 deleted file mode 100644 index 43456d5fc4c..00000000000 --- a/gcc/testsuite/gfortran.dg/submodule_2.f90 +++ /dev/null @@ -1,100 +0,0 @@ -! { dg-do run } -! -! Test dummy and result arrays in module procedures -! -! Contributed by Paul Thomas -! - module foo_interface - implicit none - type foo - character(len=16) :: greeting = "Hello, world! " - character(len=16), private :: byebye = "adieu, world! " - end type foo - - interface - module function array1(this) result (that) - type(foo), intent(in), dimension(:) :: this - type(foo), allocatable, dimension(:) :: that - end function - character(16) module function array2(this, that) - type(foo), intent(in), dimension(:) :: this - type(foo), allocatable, dimension(:) :: that - end function - module subroutine array3(this, that) - type(foo), intent(in), dimension(:) :: this - type(foo), intent(inOUT), allocatable, dimension(:) :: that - end subroutine - module subroutine array4(this, that) - type(foo), intent(in), dimension(:) :: this - type(foo), intent(inOUT), allocatable, dimension(:) :: that - end subroutine - end interface - end module - -! - SUBMODULE (foo_interface) foo_interface_son -! - contains - -! Test array characteristics for dummy and result are OK - module function array1 (this) result(that) - type(foo), intent(in), dimension(:) :: this - type(foo), allocatable, dimension(:) :: that - allocate (that(size(this)), source = this) - that%greeting = that%byebye - end function - -! Test array characteristics for dummy and result are OK for -! abbreviated module procedure declaration. - module procedure array2 - allocate (that(size(this)), source = this) - that%greeting = that%byebye - array2 = trim (that(size (that))%greeting(1:5))//", people!" - end PROCEDURE - - end SUBMODULE foo_interface_son - -! - SUBMODULE (foo_interface) foo_interface_daughter -! - contains - -! Test array characteristics for dummies are OK - module subroutine array3(this, that) - type(foo), intent(in), dimension(:) :: this - type(foo), intent(inOUT), allocatable, dimension(:) :: that - allocate (that(size(this)), source = this) - that%greeting = that%byebye - end subroutine - -! Test array characteristics for dummies are OK for -! abbreviated module procedure declaration. - module procedure array4 - integer :: i - allocate (that(size(this)), source = this) - that%greeting = that%byebye - do i = 1, size (that) - that(i)%greeting = trim (that(i)%greeting(1:5))//", people!" - end do - end PROCEDURE - end SUBMODULE foo_interface_daughter - -! - program try - use foo_interface - implicit none - type(foo), dimension(2) :: bar - type (foo), dimension(:), allocatable :: arg - - arg = array1(bar) ! typebound call - if (any (arg%greeting .ne. ["adieu, world! ", "adieu, world! "])) call abort - deallocate (arg) - if (trim (array2 (bar, arg)) .ne. "adieu, people!") call abort - deallocate (arg) - call array3 (bar, arg) ! typebound call - if (any (arg%greeting .ne. ["adieu, world! ", "adieu, world! "])) call abort - deallocate (arg) - call array4 (bar, arg) ! typebound call - if (any (arg%greeting .ne. ["adieu, people!", "adieu, people!"])) call abort - contains - end program