re PR fortran/52846 ([F2008] Support submodules)

2015-07-17  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	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: r225956

diff --git a/gcc/testsuite/gfortran.dg/submodule_7.f08 b/gcc/testsuite/gfortran.dg/submodule_7.f08
new file mode 100644 (file)
index 0000000..a183f50
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/submodule_7.f08
@@ -0,0 +1,149 @@
+! { dg-do run }
+!
+! Example in F2008 C.8.4 to demonstrate submodules
+!
+module color_points
+  type color_point
+    private
+    real :: x, y
+    integer :: color
+  end type color_point
+
+  interface
+! Interfaces for procedures with separate
+! bodies in the submodule color_points_a
+    module subroutine color_point_del ( p ) ! Destroy a color_point object
+      type(color_point), allocatable :: p
+    end subroutine color_point_del
+! Distance between two color_point objects
+    real module function color_point_dist ( a, b )
+      type(color_point), intent(in) :: a, b
+    end function color_point_dist
+    module subroutine color_point_draw ( p ) ! Draw a color_point object
+      type(color_point), intent(in) :: p
+    end subroutine color_point_draw
+    module subroutine color_point_new ( p ) ! Create a color_point object
+      type(color_point), allocatable :: p
+    end subroutine color_point_new
+    module subroutine verify_cleanup ( p1, p2 ) ! Check cleanup of color_point objects
+      type(color_point), allocatable :: p1, p2
+    end subroutine verify_cleanup
+  end interface
+end module color_points
+
+module palette_stuff
+  type :: palette ;
+!...
+  end type palette
+contains
+  subroutine test_palette ( p )
+! Draw a color wheel using procedures from the color_points module
+    use color_points ! This does not cause a circular dependency because
+! the "use palette_stuff" that is logically within
+! color_points is in the color_points_a submodule.
+    type(palette), intent(in) :: p
+  end subroutine test_palette
+end module palette_stuff
+
+
+submodule ( color_points ) color_points_a ! Submodule of color_points
+  integer :: instance_count = 0
+  interface
+! Interface for a procedure with a separate
+! body in submodule color_points_b
+    module subroutine inquire_palette ( pt, pal )
+      use palette_stuff
+! palette_stuff, especially submodules
+! thereof, can reference color_points by use
+! association without causing a circular
+! dependence during translation because this
+! use is not in the module. Furthermore,
+! changes in the module palette_stuff do not
+! affect the translation of color_points.
+      type(color_point), intent(in) :: pt
+      type(palette), intent(out) :: pal
+    end subroutine inquire_palette
+  end interface
+contains
+! Invisible bodies for public separate module procedures
+! declared in the module
+  module subroutine color_point_del ( p )
+    type(color_point), allocatable :: p
+    instance_count = instance_count - 1
+    deallocate ( p )
+  end subroutine color_point_del
+  real module function color_point_dist ( a, b ) result ( dist )
+    type(color_point), intent(in) :: a, b
+    dist = sqrt( (b%x - a%x)**2 + (b%y - a%y)**2 )
+  end function color_point_dist
+  module subroutine color_point_new ( p )
+    type(color_point), allocatable :: p
+    instance_count = instance_count + 1
+    allocate ( p )
+! Added to example so that it does something.
+    p%x = real (instance_count) * 1.0
+    p%y = real (instance_count) * 2.0
+    p%color = instance_count
+  end subroutine color_point_new
+end submodule color_points_a
+
+
+submodule ( color_points:color_points_a ) color_points_b ! Subsidiary**2 submodule
+
+contains
+! Invisible body for interface declared in the ancestor module
+  module subroutine color_point_draw ( p )
+    use palette_stuff, only: palette
+    type(color_point), intent(in) :: p
+    type(palette) :: MyPalette
+    call inquire_palette ( p, MyPalette )
+! Added to example so that it does something.
+    if (abs (p%x - real (p%color) * 1.0) .gt. 1.0e-6) call abort
+    if (abs (p%y - real (p%color) * 2.0) .gt. 1.0e-6) call abort
+  end subroutine color_point_draw
+! Invisible body for interface declared in the parent submodule
+  module procedure inquire_palette
+!... implementation of inquire_palette
+  end procedure inquire_palette
+  module procedure verify_cleanup
+    if (allocated (p1) .or. allocated (p2)) call abort
+    if (instance_count .ne. 0) call abort
+  end procedure
+  subroutine private_stuff ! not accessible from color_points_a
+!...
+  end subroutine private_stuff
+end submodule color_points_b
+
+
+program main
+  use color_points
+! "instance_count" and "inquire_palette" are not accessible here
+! because they are not declared in the "color_points" module.
+! "color_points_a" and "color_points_b" cannot be referenced by
+! use association.
+  interface draw
+! just to demonstrate it’s possible
+    module procedure color_point_draw
+  end interface
+  type(color_point), allocatable :: C_1, C_2
+  real :: RC
+!...
+  call color_point_new (c_1)
+  call color_point_new (c_2)
+! body in color_points_a, interface in color_points
+!...
+  call draw (c_1)
+! body in color_points_b, specific interface
+! in color_points, generic interface here.
+!...
+  rc = color_point_dist (c_1, c_2) ! body in color_points_a, interface in color_points
+  if (abs (rc - 2.23606801) .gt. 1.0e-6) call abort
+!...
+  call color_point_del (c_1)
+  call color_point_del (c_2)
+! body in color_points_a, interface in color_points
+  call verify_cleanup (c_1, c_2)
+!...
+end program main
+! { dg-final { cleanup-submodules "color_points@color_points_a" } }
+! { dg-final { cleanup-submodules "color_points@color_points_b" } }

diff --git a/gcc/testsuite/gfortran.dg/submodule_7.f90 b/gcc/testsuite/gfortran.dg/submodule_7.f90
deleted file mode 100644 (file)
index fd1bee6..0000000
--- a/gcc/testsuite/gfortran.dg/submodule_7.f90
+++ /dev/null
@@ -1,147 +0,0 @@
-! { dg-do run }
-!
-! Example in F2008 C.8.4 to demonstrate submodules
-!
-module color_points
-  type color_point
-    private
-    real :: x, y
-    integer :: color
-  end type color_point
-
-  interface
-! Interfaces for procedures with separate
-! bodies in the submodule color_points_a
-    module subroutine color_point_del ( p ) ! Destroy a color_point object
-      type(color_point), allocatable :: p
-    end subroutine color_point_del
-! Distance between two color_point objects
-    real module function color_point_dist ( a, b )
-      type(color_point), intent(in) :: a, b
-    end function color_point_dist
-    module subroutine color_point_draw ( p ) ! Draw a color_point object
-      type(color_point), intent(in) :: p
-    end subroutine color_point_draw
-    module subroutine color_point_new ( p ) ! Create a color_point object
-      type(color_point), allocatable :: p
-    end subroutine color_point_new
-    module subroutine verify_cleanup ( p1, p2 ) ! Check cleanup of color_point objects
-      type(color_point), allocatable :: p1, p2
-    end subroutine verify_cleanup
-  end interface
-end module color_points
-
-module palette_stuff
-  type :: palette ;
-!...
-  end type palette
-contains
-  subroutine test_palette ( p )
-! Draw a color wheel using procedures from the color_points module
-    use color_points ! This does not cause a circular dependency because
-! the "use palette_stuff" that is logically within
-! color_points is in the color_points_a submodule.
-    type(palette), intent(in) :: p
-  end subroutine test_palette
-end module palette_stuff
-
-
-submodule ( color_points ) color_points_a ! Submodule of color_points
-  integer :: instance_count = 0
-  interface
-! Interface for a procedure with a separate
-! body in submodule color_points_b
-    module subroutine inquire_palette ( pt, pal )
-      use palette_stuff
-! palette_stuff, especially submodules
-! thereof, can reference color_points by use
-! association without causing a circular
-! dependence during translation because this
-! use is not in the module. Furthermore,
-! changes in the module palette_stuff do not
-! affect the translation of color_points.
-      type(color_point), intent(in) :: pt
-      type(palette), intent(out) :: pal
-    end subroutine inquire_palette
-  end interface
-contains
-! Invisible bodies for public separate module procedures
-! declared in the module
-  module subroutine color_point_del ( p )
-    type(color_point), allocatable :: p
-    instance_count = instance_count - 1
-    deallocate ( p )
-  end subroutine color_point_del
-  real module function color_point_dist ( a, b ) result ( dist )
-    type(color_point), intent(in) :: a, b
-    dist = sqrt( (b%x - a%x)**2 + (b%y - a%y)**2 )
-  end function color_point_dist
-  module subroutine color_point_new ( p )
-    type(color_point), allocatable :: p
-    instance_count = instance_count + 1
-    allocate ( p )
-! Added to example so that it does something.
-    p%x = real (instance_count) * 1.0
-    p%y = real (instance_count) * 2.0
-    p%color = instance_count
-  end subroutine color_point_new
-end submodule color_points_a
-
-
-submodule ( color_points:color_points_a ) color_points_b ! Subsidiary**2 submodule
-
-contains
-! Invisible body for interface declared in the ancestor module
-  module subroutine color_point_draw ( p )
-    use palette_stuff, only: palette
-    type(color_point), intent(in) :: p
-    type(palette) :: MyPalette
-    call inquire_palette ( p, MyPalette )
-! Added to example so that it does something.
-    if (abs (p%x - real (p%color) * 1.0) .gt. 1.0e-6) call abort
-    if (abs (p%y - real (p%color) * 2.0) .gt. 1.0e-6) call abort
-  end subroutine color_point_draw
-! Invisible body for interface declared in the parent submodule
-  module procedure inquire_palette
-!... implementation of inquire_palette
-  end procedure inquire_palette
-  module procedure verify_cleanup
-    if (allocated (p1) .or. allocated (p2)) call abort
-    if (instance_count .ne. 0) call abort
-  end procedure
-  subroutine private_stuff ! not accessible from color_points_a
-!...
-  end subroutine private_stuff
-end submodule color_points_b
-
-
-program main
-  use color_points
-! "instance_count" and "inquire_palette" are not accessible here
-! because they are not declared in the "color_points" module.
-! "color_points_a" and "color_points_b" cannot be referenced by
-! use association.
-  interface draw
-! just to demonstrate it’s possible
-    module procedure color_point_draw
-  end interface
-  type(color_point), allocatable :: C_1, C_2
-  real :: RC
-!...
-  call color_point_new (c_1)
-  call color_point_new (c_2)
-! body in color_points_a, interface in color_points
-!...
-  call draw (c_1)
-! body in color_points_b, specific interface
-! in color_points, generic interface here.
-!...
-  rc = color_point_dist (c_1, c_2) ! body in color_points_a, interface in color_points
-  if (abs (rc - 2.23606801) .gt. 1.0e-6) call abort
-!...
-  call color_point_del (c_1)
-  call color_point_del (c_2)
-! body in color_points_a, interface in color_points
-  call verify_cleanup (c_1, c_2)
-!...
-end program main