From: Paul Thomas Date: Fri, 17 Jul 2015 17:25:04 +0000 (+0000) Subject: re PR fortran/52846 ([F2008] Support submodules) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=d5b32576ff3519c0b22707f31e2ba0a3607c17df;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: r225948 --- diff --git a/gcc/testsuite/gfortran.dg/submodule_4.f08 b/gcc/testsuite/gfortran.dg/submodule_4.f08 new file mode 100644 index 00000000000..fd1fe0cee82 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/submodule_4.f08 @@ -0,0 +1,140 @@ +! { dg-do compile } +! +! Tests comparisons of MODULE PROCEDURE characteristics and +! the characteristics of their dummies. Also tests the error +! arising from redefining dummies and results 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 + integer module function scalar1 (arg) + real, intent(in) :: arg + end function + module function scalar2 (arg) result(res) + real, intent(in) :: arg + real :: res + end function + module function scalar3 (arg) result(res) + real, intent(in) :: arg + real :: res + end function + module function scalar4 (arg) result(res) + real, intent(in) :: arg + complex :: res + end function + module function scalar5 (arg) result(res) + real, intent(in) :: arg + real, allocatable :: res + end function + module function scalar6 (arg) result(res) + real, intent(in) :: arg + real, allocatable :: res + end function + module function scalar7 (arg) result(res) + real, intent(in) :: arg + real, allocatable :: res + end function + end interface + end module + +! + SUBMODULE (foo_interface) foo_interface_son +! + contains + + module function array1 (this) result(that) ! { dg-error "Rank mismatch in function result" } + type(foo), intent(in), dimension(:) :: this + type(foo), allocatable :: that + end function + + character(16) module function array2(this) ! { dg-error "Mismatch in number of MODULE PROCEDURE formal arguments" } + type(foo), intent(in), dimension(:) :: this + type(foo), allocatable, dimension(:) :: that + allocate (that(2), source = this(1)) + that%greeting = that%byebye + array2 = trim (that(size (that))%greeting(1:5))//", people!" + end function + + module subroutine array3(thiss, that) ! { dg-error "Mismatch in MODULE PROCEDURE formal argument names" } + type(foo), intent(in), dimension(:) :: thiss + type(foo), intent(inOUT), allocatable, dimension(:) :: that + allocate (that(size(thiss)), source = thiss) + that%greeting = that%byebye + end subroutine + + module subroutine array4(this, that, the_other) ! { dg-error "Mismatch in number of MODULE PROCEDURE formal arguments" } + type(foo), intent(in), dimension(:) :: this + type(foo), intent(inOUT), allocatable, dimension(:) :: that, the_other + 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 subroutine + + recursive module function scalar1 (arg) ! { dg-error "Mismatch in RECURSIVE" } + real, intent(in) :: arg + end function + + pure module function scalar2 (arg) result(res) ! { dg-error "Mismatch in PURE" } + real, intent(in) :: arg + real :: res + end function + + module procedure scalar7 + real, intent(in) :: arg ! { dg-error "redefinition of the declaration" } + real, allocatable :: res ! { dg-error "redefinition of the declaration" } + end function ! { dg-error "Expecting END PROCEDURE statement" } + end procedure ! This prevents a cascade of errors. + end SUBMODULE foo_interface_son + +! + SUBMODULE (foo_interface) foo_interface_daughter +! + contains + + module function scalar3 (arg) result(res) ! { dg-error "Type mismatch in argument" } + integer, intent(in) :: arg + real :: res + end function + + module function scalar4 (arg) result(res) ! { dg-error "Type mismatch in function result" } + real, intent(in) :: arg + real :: res + end function + + module function scalar5 (arg) result(res) ! { dg-error "ALLOCATABLE attribute mismatch in function result " } + real, intent(in) :: arg + real :: res + end function + + module function scalar6 (arg) result(res) ! { dg-error "Rank mismatch in argument" } + real, intent(in), dimension(2) :: arg + real, allocatable :: res + end function + end SUBMODULE foo_interface_daughter diff --git a/gcc/testsuite/gfortran.dg/submodule_4.f90 b/gcc/testsuite/gfortran.dg/submodule_4.f90 deleted file mode 100644 index fd1fe0cee82..00000000000 --- a/gcc/testsuite/gfortran.dg/submodule_4.f90 +++ /dev/null @@ -1,140 +0,0 @@ -! { dg-do compile } -! -! Tests comparisons of MODULE PROCEDURE characteristics and -! the characteristics of their dummies. Also tests the error -! arising from redefining dummies and results 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 - integer module function scalar1 (arg) - real, intent(in) :: arg - end function - module function scalar2 (arg) result(res) - real, intent(in) :: arg - real :: res - end function - module function scalar3 (arg) result(res) - real, intent(in) :: arg - real :: res - end function - module function scalar4 (arg) result(res) - real, intent(in) :: arg - complex :: res - end function - module function scalar5 (arg) result(res) - real, intent(in) :: arg - real, allocatable :: res - end function - module function scalar6 (arg) result(res) - real, intent(in) :: arg - real, allocatable :: res - end function - module function scalar7 (arg) result(res) - real, intent(in) :: arg - real, allocatable :: res - end function - end interface - end module - -! - SUBMODULE (foo_interface) foo_interface_son -! - contains - - module function array1 (this) result(that) ! { dg-error "Rank mismatch in function result" } - type(foo), intent(in), dimension(:) :: this - type(foo), allocatable :: that - end function - - character(16) module function array2(this) ! { dg-error "Mismatch in number of MODULE PROCEDURE formal arguments" } - type(foo), intent(in), dimension(:) :: this - type(foo), allocatable, dimension(:) :: that - allocate (that(2), source = this(1)) - that%greeting = that%byebye - array2 = trim (that(size (that))%greeting(1:5))//", people!" - end function - - module subroutine array3(thiss, that) ! { dg-error "Mismatch in MODULE PROCEDURE formal argument names" } - type(foo), intent(in), dimension(:) :: thiss - type(foo), intent(inOUT), allocatable, dimension(:) :: that - allocate (that(size(thiss)), source = thiss) - that%greeting = that%byebye - end subroutine - - module subroutine array4(this, that, the_other) ! { dg-error "Mismatch in number of MODULE PROCEDURE formal arguments" } - type(foo), intent(in), dimension(:) :: this - type(foo), intent(inOUT), allocatable, dimension(:) :: that, the_other - 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 subroutine - - recursive module function scalar1 (arg) ! { dg-error "Mismatch in RECURSIVE" } - real, intent(in) :: arg - end function - - pure module function scalar2 (arg) result(res) ! { dg-error "Mismatch in PURE" } - real, intent(in) :: arg - real :: res - end function - - module procedure scalar7 - real, intent(in) :: arg ! { dg-error "redefinition of the declaration" } - real, allocatable :: res ! { dg-error "redefinition of the declaration" } - end function ! { dg-error "Expecting END PROCEDURE statement" } - end procedure ! This prevents a cascade of errors. - end SUBMODULE foo_interface_son - -! - SUBMODULE (foo_interface) foo_interface_daughter -! - contains - - module function scalar3 (arg) result(res) ! { dg-error "Type mismatch in argument" } - integer, intent(in) :: arg - real :: res - end function - - module function scalar4 (arg) result(res) ! { dg-error "Type mismatch in function result" } - real, intent(in) :: arg - real :: res - end function - - module function scalar5 (arg) result(res) ! { dg-error "ALLOCATABLE attribute mismatch in function result " } - real, intent(in) :: arg - real :: res - end function - - module function scalar6 (arg) result(res) ! { dg-error "Rank mismatch in argument" } - real, intent(in), dimension(2) :: arg - real, allocatable :: res - end function - end SUBMODULE foo_interface_daughter