Commit 82c027e1 by Dominique d'Humieres Committed by Dominique d'Humieres

fortran-modules.exp (igrep): New procedure, case insensitive vesrion of the dejagnu grep.

2017-06-04  Dominique d'Humieres  <dominiq@lps.ens.fr>

	* lib/fortran-modules.exp (igrep): New procedure, case insensitive
	vesrion of the dejagnu grep.
	(list-module-names): Use it and adjust the regular expressions for
	modules and submodules.
	* gfortran.dg/prof/prof.exp: Cleanup modules.
	* gfortran.dg/allocate_class_4.f90: Remove cleanup-(sub)?modules
	directives.
	* gfortran.dg/altreturn_8.f90: Likewise.
	* gfortran.dg/associate_12.f90: Likewise.
	* gfortran.dg/c_f_pointer_shape_test.f90: Likewise.
	* gfortran.dg/charlen_15.f90: Likewise.
	* gfortran.dg/class_4a.f03: Likewise.
	* gfortran.dg/class_54.f90: Likewise.
	* gfortran.dg/class_dummy_4.f03: Likewise.
	* gfortran.dg/class_dummy_5.f90: Likewise.
	* gfortran.dg/constructor_9.f90: Likewise.
	* gfortran.dg/dec_structure_15.f90: Likewise.
	* gfortran.dg/do_check_8.f90: Likewise.
	* gfortran.dg/dtio_26.f03: Likewise.
	* gfortran.dg/dynamic_dispatch_12.f90: Likewise.
	* gfortran.dg/equiv_9.f90: Likewise.
	* gfortran.dg/extends_15.f90: Likewise.
	* gfortran.dg/finalize_22.f90: Likewise.
	* gfortran.dg/finalize_23.f90: Likewise.
	* gfortran.dg/generic_26.f90: Likewise.
	* gfortran.dg/generic_27.f90: Likewise.
	* gfortran.dg/namelist_76.f90: Likewise.
	* gfortran.dg/pointer_init_8.f90: Likewise.
	* gfortran.dg/pr61318.f90: Likewise.
	* gfortran.dg/pr77260_1.f90: Likewise.
	* gfortran.dg/pr77260_2.f90: Likewise.
	* gfortran.dg/pr77420_3.f90: Likewise.
	* gfortran.dg/proc_ptr_39.f90: Likewise.
	* gfortran.dg/proc_ptr_41.f90: Likewise.
	* gfortran.dg/proc_ptr_42.f90: Likewise.
	* gfortran.dg/proc_ptr_comp_43.f90: Likewise.
	* gfortran.dg/submodule_1.f08: Likewise.
	* gfortran.dg/submodule_10.f08: Likewise.
	* gfortran.dg/submodule_14.f08: Likewise.
	* gfortran.dg/submodule_15.f08: Likewise.
	* gfortran.dg/submodule_2.f08: Likewise.
	* gfortran.dg/submodule_5.f08: Likewise.
	* gfortran.dg/submodule_6.f08: Likewise.
	* gfortran.dg/submodule_7.f08: Likewise.
	* gfortran.dg/submodule_8.f08: Likewise.
	* gfortran.dg/submodule_9.f08: Likewise.
	* gfortran.dg/transfer_class_2.f90: Likewise.
	* gfortran.dg/typebound_assignment_7.f90: Likewise.
	* gfortran.dg/typebound_call_24.f03: Likewise.
	* gfortran.dg/typebound_call_25.f90: Likewise.
	* gfortran.dg/typebound_deferred_1.f90: Likewise.
	* gfortran.dg/typebound_generic_12.f03: Likewise.
	* gfortran.dg/typebound_generic_13.f03: Likewise.
	* gfortran.dg/typebound_generic_14.f03: Likewise.
	* gfortran.dg/typebound_generic_15.f90: Likewise.
	* gfortran.dg/typebound_operator_16.f03: Likewise.
	* gfortran.dg/typebound_operator_18.f90: Likewise.
	* gfortran.dg/typebound_operator_20.f90: Likewise.
	* gfortran.dg/typebound_override_3.f90: Likewise.
	* gfortran.dg/typebound_override_4.f90: Likewise.
	* gfortran.dg/typebound_override_5.f90: Likewise.
	* gfortran.dg/typebound_override_6.f90: Likewise.
	* gfortran.dg/typebound_override_7.f90: Likewise.
	* gfortran.dg/typebound_proc_28.f03: Likewise.
	* gfortran.dg/typebound_proc_29.f90: Likewise.
	* gfortran.dg/typebound_proc_30.f90: Likewise.
	* gfortran.dg/typebound_proc_31.f90: Likewise.
	* gfortran.dg/typebound_proc_32.f90: Likewise.
	* gfortran.dg/typebound_proc_33.f90: Likewise.
	* gfortran.dg/unlimited_polymorphic_16.f90: Likewise.
	* gfortran.dg/unlimited_polymorphic_19.f90: Likewise.
	* gfortran.dg/unlimited_polymorphic_24.f03: Likewise.
	* gfortran.dg/use_only_3.f90: Likewise.
	* gfortran.dg/use_without_only_1.f90: Likewise.
	* gfortran.dg/warn_unused_function.f90: Likewise.
	* gfortran.dg/warn_unused_function_2.f90: Likewise.
	* gfortran.dg/ieee/ieee_8.f90: Likewise.

From-SVN: r248861
parent 3de4ac6d
2017-06-04 Dominique d'Humieres <dominiq@lps.ens.fr>
* lib/fortran-modules.exp (igrep): New procedure, case insensitive
vesrion of the dejagnu grep.
(list-module-names): Use it and adjust the regular expressions for
modules and submodules.
* gfortran.dg/prof/prof.exp: Cleanup modules.
* gfortran.dg/allocate_class_4.f90: Remove cleanup-(sub)?modules
directives.
* gfortran.dg/altreturn_8.f90: Likewise.
* gfortran.dg/associate_12.f90: Likewise.
* gfortran.dg/c_f_pointer_shape_test.f90: Likewise.
* gfortran.dg/charlen_15.f90: Likewise.
* gfortran.dg/class_4a.f03: Likewise.
* gfortran.dg/class_54.f90: Likewise.
* gfortran.dg/class_dummy_4.f03: Likewise.
* gfortran.dg/class_dummy_5.f90: Likewise.
* gfortran.dg/constructor_9.f90: Likewise.
* gfortran.dg/dec_structure_15.f90: Likewise.
* gfortran.dg/do_check_8.f90: Likewise.
* gfortran.dg/dtio_26.f03: Likewise.
* gfortran.dg/dynamic_dispatch_12.f90: Likewise.
* gfortran.dg/equiv_9.f90: Likewise.
* gfortran.dg/extends_15.f90: Likewise.
* gfortran.dg/finalize_22.f90: Likewise.
* gfortran.dg/finalize_23.f90: Likewise.
* gfortran.dg/generic_26.f90: Likewise.
* gfortran.dg/generic_27.f90: Likewise.
* gfortran.dg/namelist_76.f90: Likewise.
* gfortran.dg/pointer_init_8.f90: Likewise.
* gfortran.dg/pr61318.f90: Likewise.
* gfortran.dg/pr77260_1.f90: Likewise.
* gfortran.dg/pr77260_2.f90: Likewise.
* gfortran.dg/pr77420_3.f90: Likewise.
* gfortran.dg/proc_ptr_39.f90: Likewise.
* gfortran.dg/proc_ptr_41.f90: Likewise.
* gfortran.dg/proc_ptr_42.f90: Likewise.
* gfortran.dg/proc_ptr_comp_43.f90: Likewise.
* gfortran.dg/submodule_1.f08: Likewise.
* gfortran.dg/submodule_10.f08: Likewise.
* gfortran.dg/submodule_14.f08: Likewise.
* gfortran.dg/submodule_15.f08: Likewise.
* gfortran.dg/submodule_2.f08: Likewise.
* gfortran.dg/submodule_5.f08: Likewise.
* gfortran.dg/submodule_6.f08: Likewise.
* gfortran.dg/submodule_7.f08: Likewise.
* gfortran.dg/submodule_8.f08: Likewise.
* gfortran.dg/submodule_9.f08: Likewise.
* gfortran.dg/transfer_class_2.f90: Likewise.
* gfortran.dg/typebound_assignment_7.f90: Likewise.
* gfortran.dg/typebound_call_24.f03: Likewise.
* gfortran.dg/typebound_call_25.f90: Likewise.
* gfortran.dg/typebound_deferred_1.f90: Likewise.
* gfortran.dg/typebound_generic_12.f03: Likewise.
* gfortran.dg/typebound_generic_13.f03: Likewise.
* gfortran.dg/typebound_generic_14.f03: Likewise.
* gfortran.dg/typebound_generic_15.f90: Likewise.
* gfortran.dg/typebound_operator_16.f03: Likewise.
* gfortran.dg/typebound_operator_18.f90: Likewise.
* gfortran.dg/typebound_operator_20.f90: Likewise.
* gfortran.dg/typebound_override_3.f90: Likewise.
* gfortran.dg/typebound_override_4.f90: Likewise.
* gfortran.dg/typebound_override_5.f90: Likewise.
* gfortran.dg/typebound_override_6.f90: Likewise.
* gfortran.dg/typebound_override_7.f90: Likewise.
* gfortran.dg/typebound_proc_28.f03: Likewise.
* gfortran.dg/typebound_proc_29.f90: Likewise.
* gfortran.dg/typebound_proc_30.f90: Likewise.
* gfortran.dg/typebound_proc_31.f90: Likewise.
* gfortran.dg/typebound_proc_32.f90: Likewise.
* gfortran.dg/typebound_proc_33.f90: Likewise.
* gfortran.dg/unlimited_polymorphic_16.f90: Likewise.
* gfortran.dg/unlimited_polymorphic_19.f90: Likewise.
* gfortran.dg/unlimited_polymorphic_24.f03: Likewise.
* gfortran.dg/use_only_3.f90: Likewise.
* gfortran.dg/use_without_only_1.f90: Likewise.
* gfortran.dg/warn_unused_function.f90: Likewise.
* gfortran.dg/warn_unused_function_2.f90: Likewise.
* gfortran.dg/ieee/ieee_8.f90: Likewise.
2017-06-04 Marek Polacek <polacek@redhat.com> 2017-06-04 Marek Polacek <polacek@redhat.com>
PR c/80919 PR c/80919
......
...@@ -31,6 +31,3 @@ module integrable_model_module ...@@ -31,6 +31,3 @@ module integrable_model_module
end subroutine end subroutine
end module integrable_model_module end module integrable_model_module
! { dg-final { cleanup-modules "integrable_model_module" } }
! { dg-do compile } ! { dg-do compile }
! { dg-options "-std=gnu" } ! { dg-options "-std=gnu" }
! !
! PR 56284: [OOP] ICE with alternate return in type-bound procedure ! PR 56284: [OOP] ICE with alternate return in type-bound procedure
! !
! Contributed by Arjen Markus <arjen.markus@deltares.nl> ! Contributed by Arjen Markus <arjen.markus@deltares.nl>
module try_this module try_this
implicit none implicit none
type :: table_t type :: table_t
contains contains
procedure, nopass :: getRecord procedure, nopass :: getRecord
end type end type
contains contains
subroutine getRecord ( * ) subroutine getRecord ( * )
end subroutine end subroutine
end module end module
! { dg-final { cleanup-modules "try_this" } }
...@@ -25,5 +25,3 @@ program assoc_err ...@@ -25,5 +25,3 @@ program assoc_err
print *, 1. + b print *, 1. + b
end associate end associate
end program end program
! { dg-final { cleanup-modules "assoc_err_m" } }
...@@ -16,5 +16,3 @@ contains ...@@ -16,5 +16,3 @@ contains
call c_f_pointer(cPtr, myArrayPtr) ! { dg-error "Expected SHAPE argument to C_F_POINTER with array FPTR" } call c_f_pointer(cPtr, myArrayPtr) ! { dg-error "Expected SHAPE argument to C_F_POINTER with array FPTR" }
end subroutine test_0 end subroutine test_0
end module c_f_pointer_shape_test end module c_f_pointer_shape_test
! { dg-final { cleanup-modules "c_f_pointer_shape_test" } }
...@@ -10,5 +10,3 @@ program foo ...@@ -10,5 +10,3 @@ program foo
use m use m
if (trim(x%c(1)) /= 'ab') call abort if (trim(x%c(1)) /= 'ab') call abort
end program foo end program foo
! { dg-final { cleanup-modules "m" } }
...@@ -13,4 +13,3 @@ module m ...@@ -13,4 +13,3 @@ module m
type t type t
end type t end type t
end module m end module m
! { dg-final { cleanup-modules "m m2" } }
...@@ -18,5 +18,3 @@ subroutine sub2 ...@@ -18,5 +18,3 @@ subroutine sub2
use m use m
class(t), pointer :: a2 class(t), pointer :: a2
end subroutine end subroutine
! { dg-final { cleanup-modules "m" } }
...@@ -40,5 +40,3 @@ contains ...@@ -40,5 +40,3 @@ contains
type(c_stv), allocatable, intent(out) :: y type(c_stv), allocatable, intent(out) :: y
end subroutine end subroutine
end end
! { dg-final { cleanup-modules "m1 m2" } }
...@@ -26,5 +26,3 @@ contains ...@@ -26,5 +26,3 @@ contains
class(t), intent(out) :: x class(t), intent(out) :: x
end subroutine end subroutine
end end
! { dg-final { cleanup-modules "m" } }
...@@ -18,5 +18,3 @@ contains ...@@ -18,5 +18,3 @@ contains
cfd=cfmde() ! { dg-error "Can't convert" } cfd=cfmde() ! { dg-error "Can't convert" }
end subroutine end subroutine
end module end module
! { dg-final { cleanup-modules "cf" } }
...@@ -24,4 +24,3 @@ contains ...@@ -24,4 +24,3 @@ contains
a2 = 0.0 a2 = 0.0
end function end function
end module end module
! { dg-final { cleanup-modules "dec_structure_15" } }
...@@ -56,4 +56,3 @@ program main ...@@ -56,4 +56,3 @@ program main
call sub(undeclared) call sub(undeclared)
end do end do
end program main end program main
! { dg-final { cleanup-modules "foo" } }
...@@ -65,5 +65,3 @@ program p ...@@ -65,5 +65,3 @@ program p
read( unit=s, fmt=*, iostat=istat, iomsg=imsg) foo read( unit=s, fmt=*, iostat=istat, iomsg=imsg) foo
if (imsg.ne."End of record") call abort if (imsg.ne."End of record") call abort
end program p end program p
! { dg-final { cleanup-modules "t_m" } }
...@@ -70,5 +70,3 @@ contains ...@@ -70,5 +70,3 @@ contains
end subroutine end subroutine
end end
! { dg-final { cleanup-modules "TestResult_mod BaseTestRunner_mod TestRunner_mod" } }
...@@ -19,4 +19,3 @@ subroutine another() ...@@ -19,4 +19,3 @@ subroutine another()
implicit none implicit none
if (x2 /= 2) call abort if (x2 /= 2) call abort
end subroutine end subroutine
! { dg-final { cleanup-modules "constant" } }
...@@ -12,5 +12,3 @@ module ct ...@@ -12,5 +12,3 @@ module ct
type :: t1 type :: t1
end type end type
end end
! { dg-final { cleanup-modules "ct" } }
...@@ -16,5 +16,3 @@ contains ...@@ -16,5 +16,3 @@ contains
class(cfml), intent(inout) :: s class(cfml), intent(inout) :: s
end subroutine mld end subroutine mld
end module cf end module cf
! { dg-final { cleanup-modules "cf" } }
...@@ -27,5 +27,3 @@ contains ...@@ -27,5 +27,3 @@ contains
end function end function
end module end module
! { dg-final { cleanup-modules "ObjectLists" } }
...@@ -25,5 +25,3 @@ contains ...@@ -25,5 +25,3 @@ contains
end function end function
end end
! { dg-final { cleanup-modules "a" } }
...@@ -30,5 +30,3 @@ program test ...@@ -30,5 +30,3 @@ program test
if (testIF(cos)/=1.0) call abort() if (testIF(cos)/=1.0) call abort()
end program end program
! { dg-final { cleanup-modules "m" } }
...@@ -111,5 +111,3 @@ subroutine gee(n, rounding, flag) ...@@ -111,5 +111,3 @@ subroutine gee(n, rounding, flag)
if (len(s8) /= x8) call abort if (len(s8) /= x8) call abort
end subroutine end subroutine
! { dg-final { cleanup-modules "foo bar" } }
...@@ -24,5 +24,3 @@ subroutine write_data() ...@@ -24,5 +24,3 @@ subroutine write_data()
write(10, nml=write_data_list) write(10, nml=write_data_list)
close(10) close(10)
end subroutine write_data end subroutine write_data
! { dg-final { cleanup-modules "data" } }
...@@ -22,5 +22,3 @@ end module m ...@@ -22,5 +22,3 @@ end module m
if (.not. associated(py, y)) call abort() if (.not. associated(py, y)) call abort()
if (.not. same_type_as(py, y)) call abort() if (.not. same_type_as(py, y)) call abort()
end end
! { dg-final { cleanup-modules "m" } }
...@@ -20,4 +20,3 @@ program test ...@@ -20,4 +20,3 @@ program test
use gbl_interfaces use gbl_interfaces
call gagout(seve%e,'Some string') ! { dg-error "Type mismatch in argument" } call gagout(seve%e,'Some string') ! { dg-error "Type mismatch in argument" }
end program test end program test
! { dg-final { cleanup-modules "gbl_interfaces gbl_message" } }
...@@ -22,4 +22,3 @@ program test ...@@ -22,4 +22,3 @@ program test
implicit none implicit none
print *,f2() print *,f2()
end program end program
! { dg-final { cleanup-modules "foo" } }
...@@ -23,4 +23,3 @@ program test ...@@ -23,4 +23,3 @@ program test
implicit none implicit none
print *,f2() print *,f2()
end program end program
! { dg-final { cleanup-modules "foo" } }
...@@ -6,4 +6,3 @@ module h5global ...@@ -6,4 +6,3 @@ module h5global
integer :: h5p_default_f, h5p_flags integer :: h5p_default_f, h5p_flags
equivalence(h5p_flags, h5p_default_f) equivalence(h5p_flags, h5p_default_f)
end module h5global end module h5global
! { dg-final { cleanup-modules "h5global" } }
...@@ -17,5 +17,3 @@ program Test ...@@ -17,5 +17,3 @@ program Test
use Module1 use Module1
use Module2 use Module2
end program end program
! { dg-final { cleanup-modules "Module1 Module2" } }
...@@ -33,5 +33,3 @@ program crash_test ...@@ -33,5 +33,3 @@ program crash_test
ptr => generic_name_get_proc_ptr() ptr => generic_name_get_proc_ptr()
end program end program
! { dg-final { cleanup-modules "test" } }
...@@ -32,5 +32,3 @@ program p ...@@ -32,5 +32,3 @@ program p
use m2 use m2
call ns_dirdata(f) call ns_dirdata(f)
end end
! { dg-final { cleanup-modules "m1 m2" } }
...@@ -18,6 +18,7 @@ ...@@ -18,6 +18,7 @@
# ordering using -fprofile-generate followed by -fprofile-use. # ordering using -fprofile-generate followed by -fprofile-use.
load_lib target-supports.exp load_lib target-supports.exp
load_lib fortran-modules.exp
# Some targets don't support tree profiling. # Some targets don't support tree profiling.
if { ![check_profiling_available "-fprofile-generate"] } { if { ![check_profiling_available "-fprofile-generate"] } {
...@@ -50,7 +51,9 @@ foreach src [lsort [glob -nocomplain $srcdir/$subdir/*.f*]] { ...@@ -50,7 +51,9 @@ foreach src [lsort [glob -nocomplain $srcdir/$subdir/*.f*]] {
if ![runtest_file_p $runtests $src] then { if ![runtest_file_p $runtests $src] then {
continue continue
} }
list-module-names $src
profopt-execute $src profopt-execute $src
cleanup-modules ""
} }
foreach src [lsort [glob -nocomplain $srcdir/$subdir/*.f*]] { foreach src [lsort [glob -nocomplain $srcdir/$subdir/*.f*]] {
......
...@@ -170,6 +170,3 @@ ...@@ -170,6 +170,3 @@
message2 = "" message2 = ""
end subroutine end subroutine
end program end program
! { dg-final { cleanup-submodules "foo_interface@foo_interface_son" } }
! { dg-final { cleanup-submodules "foo_interface@foo_interface_grandson" } }
! { dg-final { cleanup-submodules "foo_interface@foo_interface_daughter" } }
...@@ -167,5 +167,3 @@ program testlk ...@@ -167,5 +167,3 @@ program testlk
stop stop
end program testlk end program testlk
! { dg-final { cleanup-submodules "error_mod@error_impl_mod" } }
...@@ -46,4 +46,3 @@ end submodule testson ...@@ -46,4 +46,3 @@ end submodule testson
x = 10 x = 10
if (fcn1 (x) .ne. 0) call abort if (fcn1 (x) .ne. 0) call abort
end end
! { dg-final { cleanup-submodules "test@testson" } }
...@@ -56,4 +56,3 @@ end submodule ...@@ -56,4 +56,3 @@ end submodule
incr = 1 incr = 1
if (a3(i) .ne. 11) call abort if (a3(i) .ne. 11) call abort
end end
! { dg-final { cleanup-submodules "a@a_son" } }
...@@ -98,5 +98,3 @@ ...@@ -98,5 +98,3 @@
if (any (arg%greeting .ne. ["adieu, people!", "adieu, people!"])) call abort if (any (arg%greeting .ne. ["adieu, people!", "adieu, people!"])) call abort
contains contains
end program end program
! { dg-final { cleanup-submodules "foo_interface@foo_interface_son" } }
! { dg-final { cleanup-submodules "foo_interface@foo_interface_daughter" } }
...@@ -57,4 +57,3 @@ contains ...@@ -57,4 +57,3 @@ contains
end SUBMODULE foo_interface_daughter end SUBMODULE foo_interface_daughter
end end
! { dg-final { cleanup-submodules "foo_interface@foo_interface_daughter" } }
...@@ -92,6 +92,3 @@ program p ...@@ -92,6 +92,3 @@ program p
call p_a(a, create_b([3,4,5])) call p_a(a, create_b([3,4,5]))
call print(a) call print(a)
end program p end program p
! { dg-final { cleanup-submodules "mod_a@imp_p_a" } }
! { dg-final { cleanup-submodules "mod_b@imp_create" } }
...@@ -145,5 +145,3 @@ program main ...@@ -145,5 +145,3 @@ program main
call verify_cleanup (c_1, c_2) call verify_cleanup (c_1, c_2)
!... !...
end program main end program main
! { dg-final { cleanup-submodules "color_points@color_points_a" } }
! { dg-final { cleanup-submodules "color_points@color_points_b" } }
...@@ -41,4 +41,3 @@ program a_s ...@@ -41,4 +41,3 @@ program a_s
call abort call abort
end if end if
end program end program
! { dg-final { cleanup-submodules "mod_a@mod_s" } }
...@@ -38,4 +38,3 @@ program a_s ...@@ -38,4 +38,3 @@ program a_s
implicit none implicit none
call p() call p()
end program end program
! { dg-final { cleanup-submodules "mod_a@b" } }
...@@ -41,5 +41,3 @@ program p ...@@ -41,5 +41,3 @@ program p
if (c%i /= 4) call abort() if (c%i /= 4) call abort()
end end
! { dg-final { cleanup-modules "m" } }
...@@ -62,5 +62,3 @@ program test_assign ...@@ -62,5 +62,3 @@ program test_assign
end select end select
end end
! { dg-final { cleanup-modules "mod1 mod2" } }
...@@ -20,5 +20,3 @@ program bug2 ...@@ -20,5 +20,3 @@ program bug2
class(aqq_t) :: aqq ! { dg-error "must be dummy, allocatable or pointer" } class(aqq_t) :: aqq ! { dg-error "must be dummy, allocatable or pointer" }
call aqq%aqq_init call aqq%aqq_init
end program end program
! { dg-final { cleanup-modules "aqq_m" } }
...@@ -34,5 +34,3 @@ CONTAINS ...@@ -34,5 +34,3 @@ CONTAINS
END SUBROUTINE END SUBROUTINE
END MODULE END MODULE
! { dg-final { cleanup-modules "my_mod" } }
...@@ -19,5 +19,3 @@ contains ...@@ -19,5 +19,3 @@ contains
end subroutine inter end subroutine inter
end module m end module m
! { dg-final { cleanup-modules "m" } }
...@@ -22,5 +22,3 @@ contains ...@@ -22,5 +22,3 @@ contains
class(t) :: this class(t) :: this
end subroutine sub2 end subroutine sub2
end module m end module m
! { dg-final { cleanup-modules "m" } }
...@@ -24,5 +24,3 @@ contains ...@@ -24,5 +24,3 @@ contains
end subroutine end subroutine
end module end module
! { dg-final { cleanup-modules "m" } }
...@@ -23,5 +23,3 @@ contains ...@@ -23,5 +23,3 @@ contains
end subroutine end subroutine
end module end module
! { dg-final { cleanup-modules "a_mod" } }
...@@ -14,5 +14,3 @@ module Objects ...@@ -14,5 +14,3 @@ module Objects
end Type end Type
end module end module
! { dg-final { cleanup-modules "Objects" } }
...@@ -45,5 +45,3 @@ contains ...@@ -45,5 +45,3 @@ contains
myadd = a%x + b myadd = a%x + b
end function MyAdd end function MyAdd
end module end module
! { dg-final { cleanup-modules "M1 M2" } }
...@@ -21,5 +21,3 @@ contains ...@@ -21,5 +21,3 @@ contains
class(athlete) ,intent(in) :: this class(athlete) ,intent(in) :: this
end function end function
end module end module
! { dg-final { cleanup-modules "athlete_module" } }
...@@ -49,5 +49,3 @@ program drive ...@@ -49,5 +49,3 @@ program drive
if (h1%sum(h2) /= 1) call abort() if (h1%sum(h2) /= 1) call abort()
end end
! { dg-final { cleanup-modules "overwrite" } }
...@@ -30,5 +30,3 @@ contains ...@@ -30,5 +30,3 @@ contains
name = "name_B" name = "name_B"
end function end function
end module end module
! { dg-final { cleanup-modules "dtAs dtBs" } }
...@@ -30,5 +30,3 @@ contains ...@@ -30,5 +30,3 @@ contains
class(r_type) :: mapout class(r_type) :: mapout
end subroutine end subroutine
end module end module
! { dg-final { cleanup-modules "base_mod r_mod" } }
! { dg-do compile } ! { dg-do compile }
! !
! PR 54190: TYPE(*)/assumed-rank: Type/rank check too relaxed for dummy procedure ! PR 54190: TYPE(*)/assumed-rank: Type/rank check too relaxed for dummy procedure
! PR 57217: [4.7/4.8/4.9 Regression][OOP] Accepts invalid TBP overriding - lacking arguments check ! PR 57217: [4.7/4.8/4.9 Regression][OOP] Accepts invalid TBP overriding - lacking arguments check
! !
! Contributed by Tobias Burnus <burnus@gcc.gnu.org> ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
module base_mod module base_mod
implicit none implicit none
type base_type type base_type
integer :: kind integer :: kind
contains contains
procedure, pass(map) :: clone => base_clone procedure, pass(map) :: clone => base_clone
end type end type
contains contains
subroutine base_clone(map,mapout,info) subroutine base_clone(map,mapout,info)
class(base_type), intent(inout) :: map class(base_type), intent(inout) :: map
class(base_type), intent(inout) :: mapout class(base_type), intent(inout) :: mapout
integer :: info integer :: info
end subroutine end subroutine
end module end module
module r_mod module r_mod
use base_mod use base_mod
implicit none implicit none
type, extends(base_type) :: r_type type, extends(base_type) :: r_type
real :: dat real :: dat
contains contains
procedure, pass(map) :: clone => r_clone ! { dg-error "Type mismatch in argument" } procedure, pass(map) :: clone => r_clone ! { dg-error "Type mismatch in argument" }
end type end type
contains contains
subroutine r_clone(map,mapout,info) subroutine r_clone(map,mapout,info)
class(r_type), intent(inout) :: map class(r_type), intent(inout) :: map
!gcc$ attributes no_arg_check :: mapout !gcc$ attributes no_arg_check :: mapout
integer, intent(inout) :: mapout integer, intent(inout) :: mapout
integer :: info integer :: info
end subroutine end subroutine
end module end module
! { dg-final { cleanup-modules "base_mod r_mod" } }
! { dg-do compile } ! { dg-do compile }
! !
! PR 54190: TYPE(*)/assumed-rank: Type/rank check too relaxed for dummy procedure ! PR 54190: TYPE(*)/assumed-rank: Type/rank check too relaxed for dummy procedure
! PR 57217: [4.7/4.8/4.9 Regression][OOP] Accepts invalid TBP overriding - lacking arguments check ! PR 57217: [4.7/4.8/4.9 Regression][OOP] Accepts invalid TBP overriding - lacking arguments check
! !
! Contributed by Tobias Burnus <burnus@gcc.gnu.org> ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
module base_mod module base_mod
implicit none implicit none
type base_type type base_type
integer :: kind integer :: kind
contains contains
procedure, pass(map) :: clone => base_clone procedure, pass(map) :: clone => base_clone
end type end type
contains contains
subroutine base_clone(map,mapout,info) subroutine base_clone(map,mapout,info)
class(base_type), intent(inout) :: map class(base_type), intent(inout) :: map
class(base_type), intent(inout) :: mapout class(base_type), intent(inout) :: mapout
integer :: info integer :: info
end subroutine end subroutine
end module end module
module r_mod module r_mod
use base_mod use base_mod
implicit none implicit none
type, extends(base_type) :: r_type type, extends(base_type) :: r_type
real :: dat real :: dat
contains contains
procedure, pass(map) :: clone => r_clone ! { dg-error "Rank mismatch in argument" } procedure, pass(map) :: clone => r_clone ! { dg-error "Rank mismatch in argument" }
end type end type
contains contains
subroutine r_clone(map,mapout,info) subroutine r_clone(map,mapout,info)
class(r_type), intent(inout) :: map class(r_type), intent(inout) :: map
class(base_type), intent(inout) :: mapout(..) class(base_type), intent(inout) :: mapout(..)
integer :: info integer :: info
end subroutine end subroutine
end module end module
! { dg-final { cleanup-modules "base_mod r_mod" } }
! { dg-do compile } ! { dg-do compile }
! !
! PR 54190: TYPE(*)/assumed-rank: Type/rank check too relaxed for dummy procedure ! PR 54190: TYPE(*)/assumed-rank: Type/rank check too relaxed for dummy procedure
! PR 57217: [4.7/4.8/4.9 Regression][OOP] Accepts invalid TBP overriding - lacking arguments check ! PR 57217: [4.7/4.8/4.9 Regression][OOP] Accepts invalid TBP overriding - lacking arguments check
! !
! Contributed by Tobias Burnus <burnus@gcc.gnu.org> ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
module base_mod module base_mod
implicit none implicit none
type base_type type base_type
integer :: kind integer :: kind
contains contains
procedure, pass(map) :: clone => base_clone procedure, pass(map) :: clone => base_clone
end type end type
contains contains
subroutine base_clone(map,mapout,info) subroutine base_clone(map,mapout,info)
class(base_type), intent(inout) :: map class(base_type), intent(inout) :: map
class(base_type), intent(inout) :: mapout class(base_type), intent(inout) :: mapout
integer :: info integer :: info
end subroutine end subroutine
end module end module
module r_mod module r_mod
use base_mod use base_mod
implicit none implicit none
type, extends(base_type) :: r_type type, extends(base_type) :: r_type
real :: dat real :: dat
contains contains
procedure, pass(map) :: clone => r_clone ! { dg-error "Type mismatch in argument" } procedure, pass(map) :: clone => r_clone ! { dg-error "Type mismatch in argument" }
end type end type
contains contains
subroutine r_clone(map,mapout,info) subroutine r_clone(map,mapout,info)
class(r_type), intent(inout) :: map class(r_type), intent(inout) :: map
type(*), intent(inout) :: mapout type(*), intent(inout) :: mapout
integer :: info integer :: info
end subroutine end subroutine
end module end module
! { dg-final { cleanup-modules "base_mod r_mod" } }
...@@ -26,5 +26,3 @@ contains ...@@ -26,5 +26,3 @@ contains
end function end function
end module end module
! { dg-final { cleanup-modules "t" } }
...@@ -22,5 +22,3 @@ program abstract ...@@ -22,5 +22,3 @@ program abstract
type(pdf) pp type(pdf) pp
print pp%getx() ! { dg-error "must be of type default-kind CHARACTER or of INTEGER" } print pp%getx() ! { dg-error "must be of type default-kind CHARACTER or of INTEGER" }
end program end program
! { dg-final { cleanup-modules "pdfs" } }
...@@ -34,5 +34,3 @@ contains ...@@ -34,5 +34,3 @@ contains
end function end function
end module end module
! { dg-final { cleanup-modules "phs_single" } }
...@@ -24,5 +24,3 @@ contains ...@@ -24,5 +24,3 @@ contains
end function end function
end module end module
! { dg-final { cleanup-modules "classes" } }
...@@ -31,5 +31,3 @@ contains ...@@ -31,5 +31,3 @@ contains
end function end function
end module end module
! { dg-final { cleanup-modules "classes" } }
...@@ -35,5 +35,3 @@ contains ...@@ -35,5 +35,3 @@ contains
end subroutine end subroutine
end end
! { dg-final { cleanup-modules "ObjectLists" } }
...@@ -20,5 +20,3 @@ contains ...@@ -20,5 +20,3 @@ contains
end subroutine end subroutine
end module end module
! { dg-final { cleanup-modules "IO" } }
...@@ -49,5 +49,3 @@ CONTAINS ...@@ -49,5 +49,3 @@ CONTAINS
END SELECT; END SELECT END SELECT; END SELECT
END SUBROUTINE copy_int END SUBROUTINE copy_int
END PROGRAM main END PROGRAM main
! { dg-final { cleanup-modules "m" } }
...@@ -214,5 +214,3 @@ program main ...@@ -214,5 +214,3 @@ program main
end select end select
end do end do
end program main end program main
! { dg-final { cleanup-modules "list_mod link_mod" } }
...@@ -32,4 +32,3 @@ subroutine dforceb(c0, i, betae, ipol, bec0, ctabin, gqq, gqqm, qmat, dq2, df) ...@@ -32,4 +32,3 @@ subroutine dforceb(c0, i, betae, ipol, bec0, ctabin, gqq, gqqm, qmat, dq2, df)
& dq2, gmes & dq2, gmes
end subroutine dforceb end subroutine dforceb
! { dg-final { cleanup-modules "cell_base constants control_flags cvan electrons_base electrons_nose gvecs gvecw ions_base kinds parameters" } }
...@@ -19,4 +19,3 @@ CONTAINS ...@@ -19,4 +19,3 @@ CONTAINS
USE ISO_C_BINDING ! { dg-warning "9:has no ONLY qualifier" } USE ISO_C_BINDING ! { dg-warning "9:has no ONLY qualifier" }
END SUBROUTINE S3 END SUBROUTINE S3
END MODULE END MODULE
! { dg-final { cleanup-modules "foo testmod" } }
...@@ -17,5 +17,3 @@ contains ...@@ -17,5 +17,3 @@ contains
print *, "Hello ", a, "!" print *, "Hello ", a, "!"
end subroutine end subroutine
end module end module
! { dg-final { cleanup-modules "mod_say_hello" } }
...@@ -39,5 +39,3 @@ contains ...@@ -39,5 +39,3 @@ contains
subroutine s5 ! { dg-warning "defined but not used" } subroutine s5 ! { dg-warning "defined but not used" }
end subroutine end subroutine
end end
! { dg-final { cleanup-modules "m" } }
...@@ -79,10 +79,14 @@ proc list-module-names { files } { ...@@ -79,10 +79,14 @@ proc list-module-names { files } {
proc list-module-names-1 { file } { proc list-module-names-1 { file } {
set result {} set result {}
set tmp [grep $file "^\[ \t\]*((#)?\[ \t\]*include|\[mM\]\[oO\]\[dD\]\[uU\]\[lL\]\[eE\](?!\[ \t\]+\[pP\]\[rR\]\[oO\]\[cC\]\[eE\]\[dD\]\[uU\]\[rR\]\[eE\]\[ \t\]+))\[ \t\]+.*" line] if {[file isdirectory $file]} {return}
# Find lines containing INCLUDE, MODULE, and SUBMODULE, excluding the lines containing
# MODULE [PURE|(IMPURE\s+)?ELEMENTAL|RECURSIVE] (PROCEDURE|FUNCTION|SUBROUTINE)
set pat {^\s*((#)?\s*include|(sub)?module(?!\s+((pure|(impure\s+)?elemental|recursive)\s+)?(procedure|function|subroutine)[:\s]+))\s*.*}
set tmp [igrep $file $pat line]
if {![string match "" $tmp]} { if {![string match "" $tmp]} {
foreach i $tmp { foreach i $tmp {
regexp "(\[0-9\]+)\[ \t\]+(?:(?:#)?\[ \t\]*include\[ \t\]+)\[\"\](\[^\"\]*)\[\"\]" $i dummy lineno include_file regexp -nocase {(\d+)\s+#?\s*include\s+["']([^"']*)["']} $i dummy lineno include_file
if {[info exists include_file]} { if {[info exists include_file]} {
set dir [file dirname $file] set dir [file dirname $file]
set inc "$dir/$include_file" set inc "$dir/$include_file"
...@@ -99,10 +103,16 @@ proc list-module-names-1 { file } { ...@@ -99,10 +103,16 @@ proc list-module-names-1 { file } {
} }
continue continue
} }
regexp "(\[0-9\]+)\[ \t\]+(?:(\[mM\]\[oO\]\[dD\]\[uU\]\[lL\]\[eE\]\[ \t\]+(?!\[pP\]\[rR\]\[oO\]\[cC\]\[eE\]\[dD\]\[uU\]\[rR\]\[eE\]\[ \t\]+)))(\[^ \t;\]*)" $i i lineno keyword mod regexp -nocase {(\d+)\s+(module|submodule)\s*([^;]*)} $i i lineno keyword mod
if {![info exists lineno]} { if {![info exists mod]} {
continue continue
} }
# Generates the file name mod_name@submod_name from
# (\s*mod_name[:submod_name]\s*)\s*submod_name\s*[! comment]
regsub {\s*!.*} $mod "" mod
regsub {:[^)]*} $mod "" mod
regsub {\(\s*} $mod "" mod
regsub {\s*\)\s*} $mod "@" mod
verbose "Line $lineno mentions module `$mod'" 3 verbose "Line $lineno mentions module `$mod'" 3
if {[lsearch $result $mod] < 0} { if {[lsearch $result $mod] < 0} {
lappend result $mod lappend result $mod
...@@ -111,3 +121,54 @@ proc list-module-names-1 { file } { ...@@ -111,3 +121,54 @@ proc list-module-names-1 { file } {
} }
return $result return $result
} }
# Looks for case insensitive occurrences of a string in a file.
# return:list of lines that matched or NULL if none match.
# args: first arg is the filename,
# second is the pattern,
# third are any options.
# Options: line - puts line numbers of match in list
#
proc igrep { args } {
set file [lindex $args 0]
set pattern [lindex $args 1]
verbose "Grepping $file for the pattern \"$pattern\"" 3
set argc [llength $args]
if { $argc > 2 } {
for { set i 2 } { $i < $argc } { incr i } {
append options [lindex $args $i]
append options " "
}
} else {
set options ""
}
set i 0
set fd [open $file r]
while { [gets $fd cur_line]>=0 } {
incr i
if {[regexp -nocase -- "$pattern" $cur_line match]} {
if {![string match "" $options]} {
foreach opt $options {
switch $opt {
"line" {
lappend grep_out [concat $i $match]
}
}
}
} else {
lappend grep_out $match
}
}
}
close $fd
unset fd
unset i
if {![info exists grep_out]} {
set grep_out ""
}
return $grep_out
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment