From: Paul Thomas Date: Fri, 17 Jul 2015 17:26:12 +0000 (+0000) Subject: re PR fortran/52846 ([F2008] Support submodules) X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=91ff0ece84ae17071455b7de1ff624d42b7859ab;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: r225955 --- diff --git a/gcc/testsuite/gfortran.dg/submodule_6.f08 b/gcc/testsuite/gfortran.dg/submodule_6.f08 new file mode 100644 index 00000000000..e0b195e91de --- /dev/null +++ b/gcc/testsuite/gfortran.dg/submodule_6.f08 @@ -0,0 +1,93 @@ +! { dg-do run } +! +! Checks that the results of module procedures have the correct characteristics. +! +! Contributed by Reinhold Bader +! +module mod_a + implicit none + type, abstract :: t_a + end type t_a + interface + module subroutine p_a(this, q) + class(t_a), intent(inout) :: this + class(*), intent(in) :: q + end subroutine + module function create_a() result(r) + class(t_a), allocatable :: r + end function + module subroutine print(this) + class(t_a), intent(in) :: this + end subroutine + end interface +end module mod_a + +module mod_b + implicit none + type t_b + integer, allocatable :: I(:) + end type t_b + interface + module function create_b(i) result(r) + type(t_b) :: r + integer :: i(:) + end function + end interface +end module mod_b + +submodule(mod_b) imp_create +contains + module procedure create_b + if (allocated(r%i)) deallocate(r%i) + allocate(r%i, source=i) + end procedure +end submodule imp_create + +submodule(mod_a) imp_p_a + use mod_b + type, extends(t_a) :: t_imp + type(t_b) :: b + end type t_imp + integer, parameter :: ii(2) = [1,2] +contains + module procedure create_a + type(t_b) :: b + b = create_b(ii) + allocate(r, source=t_imp(b)) + end procedure + + module procedure p_a + select type (this) + type is (t_imp) + select type (q) + type is (t_b) + this%b = q + class default + call abort + end select + class default + call abort + end select + end procedure p_a + module procedure print + select type (this) + type is (t_imp) + if (any (this%b%i .ne. [3,4,5])) call abort + class default + call abort + end select + end procedure +end submodule imp_p_a + +program p + use mod_a + use mod_b + implicit none + class(t_a), allocatable :: a + allocate(a, source=create_a()) + call p_a(a, create_b([3,4,5])) + call print(a) +end program p +! { dg-final { cleanup-submodules "mod_a@imp_p_a" } } +! { dg-final { cleanup-submodules "mod_b@imp_create" } } + diff --git a/gcc/testsuite/gfortran.dg/submodule_6.f90 b/gcc/testsuite/gfortran.dg/submodule_6.f90 deleted file mode 100644 index b018b59f3da..00000000000 --- a/gcc/testsuite/gfortran.dg/submodule_6.f90 +++ /dev/null @@ -1,91 +0,0 @@ -! { dg-do run } -! -! Checks that the results of module procedures have the correct characteristics. -! -! Contributed by Reinhold Bader -! -module mod_a - implicit none - type, abstract :: t_a - end type t_a - interface - module subroutine p_a(this, q) - class(t_a), intent(inout) :: this - class(*), intent(in) :: q - end subroutine - module function create_a() result(r) - class(t_a), allocatable :: r - end function - module subroutine print(this) - class(t_a), intent(in) :: this - end subroutine - end interface -end module mod_a - -module mod_b - implicit none - type t_b - integer, allocatable :: I(:) - end type t_b - interface - module function create_b(i) result(r) - type(t_b) :: r - integer :: i(:) - end function - end interface -end module mod_b - -submodule(mod_b) imp_create -contains - module procedure create_b - if (allocated(r%i)) deallocate(r%i) - allocate(r%i, source=i) - end procedure -end submodule imp_create - -submodule(mod_a) imp_p_a - use mod_b - type, extends(t_a) :: t_imp - type(t_b) :: b - end type t_imp - integer, parameter :: ii(2) = [1,2] -contains - module procedure create_a - type(t_b) :: b - b = create_b(ii) - allocate(r, source=t_imp(b)) - end procedure - - module procedure p_a - select type (this) - type is (t_imp) - select type (q) - type is (t_b) - this%b = q - class default - call abort - end select - class default - call abort - end select - end procedure p_a - module procedure print - select type (this) - type is (t_imp) - if (any (this%b%i .ne. [3,4,5])) call abort - class default - call abort - end select - end procedure -end submodule imp_p_a - -program p - use mod_a - use mod_b - implicit none - class(t_a), allocatable :: a - allocate(a, source=create_a()) - call p_a(a, create_b([3,4,5])) - call print(a) -end program p -