From 2929accc55672ccac9033c6946b7eef44d99cf05 Mon Sep 17 00:00:00 2001
From: Bernhard Reutner-Fischer <rep.dot.nop@gmail.com>
Date: Tue, 28 Feb 2012 22:12:16 +0100
Subject: [PATCH] gfortran testsuite: implicitly cleanup-modules
gcc/ChangeLog:
2012-02-28 Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
* doc/sourcebuild.texi (cleanup-modules, keep-modules): Update
documentation.
gcc/testsuite/ChangeLog:
2012-02-28 Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
* gfortran.fortran-torture/compile/compile.exp: Simplify.
* gfortran.fortran-torture/execute/execute.exp: Likewise.
* lib/gcc-dg.exp (cleanup-modules): Move to ..
* lib/fortran-modules.exp: .. this new file. Adjust users.
* lib/gfortran-dg.exp (gfortran-dg-runtest,
gfortran-dg-debug-runtest): Call cleanup-modules.
* lib/fortran-torture.exp (fortran-torture-execute,
fortran-torture): Likewise.
* gfortran.dg/coarray/caf.exp: Likewise.
* lib/lto.exp: Likewise.
* gfortran.dg/class_4a.f03: Adjust cleanup-modules and keep-modules.
* gfortran.dg/class_4b.f03: Likewise.
* gfortran.dg/class_4c.f03: Likewise.
* gfortran.dg/class_45a.f03: Likewise.
* gfortran.dg/binding_label_tests_10.f03: Likewise.
* gfortran.dg/binding_label_tests_10_main.f03: Likewise.
* gfortran.dg/binding_label_tests_11.f03: Likewise.
* gfortran.dg/binding_label_tests_11_main.f03: Likewise.
* gfortran.dg/binding_label_tests_13.f03: Likewise.
* gfortran.dg/binding_label_tests_13_main.f03: Likewise.
* gfortran.dg/test_common_binding_labels_2.f03: Likewise.
* gfortran.dg/test_common_binding_labels_2_main.f03: Likewise.
* gfortran.dg/test_common_binding_labels_3.f03: Likewise.
* gfortran.dg/test_common_binding_labels_3_main.f03: Likewise.
* gfortran.dg/whole_file_28.f90: Likewise.
* gfortran.dg/whole_file_29.f90: Likewise.
* gfortran.dg/whole_file_30.f90: Likewise.
* gfortran.dg/whole_file_31.f90: Likewise.
Signed-off-by: Bernhard Reutner-Fischer <rep.dot.nop@gmail.com>
---
gcc/doc/sourcebuild.texi | 35 +++++++-
.../gfortran.dg/binding_label_tests_10.f03 | 3 +-
.../gfortran.dg/binding_label_tests_10_main.f03 | 3 +-
.../gfortran.dg/binding_label_tests_11.f03 | 3 +-
.../gfortran.dg/binding_label_tests_11_main.f03 | 3 +-
.../gfortran.dg/binding_label_tests_13.f03 | 1 +
.../gfortran.dg/binding_label_tests_13_main.f03 | 3 +-
gcc/testsuite/gfortran.dg/class_45a.f03 | 1 +
gcc/testsuite/gfortran.dg/class_4a.f03 | 1 +
gcc/testsuite/gfortran.dg/class_4b.f03 | 1 +
gcc/testsuite/gfortran.dg/class_4c.f03 | 3 +-
gcc/testsuite/gfortran.dg/coarray/caf.exp | 3 +
.../gfortran.dg/test_common_binding_labels_2.f03 | 2 +-
.../test_common_binding_labels_2_main.f03 | 3 +-
.../gfortran.dg/test_common_binding_labels_3.f03 | 1 +
.../test_common_binding_labels_3_main.f03 | 3 +-
gcc/testsuite/gfortran.dg/whole_file_28.f90 | 1 +
gcc/testsuite/gfortran.dg/whole_file_29.f90 | 2 +-
gcc/testsuite/gfortran.dg/whole_file_30.f90 | 1 +
gcc/testsuite/gfortran.dg/whole_file_31.f90 | 2 +-
.../gfortran.fortran-torture/compile/compile.exp | 65 +-------------
.../gfortran.fortran-torture/execute/execute.exp | 65 +-------------
gcc/testsuite/lib/fortran-modules.exp | 98 ++++++++++++++++++++
gcc/testsuite/lib/fortran-torture.exp | 7 +-
gcc/testsuite/lib/gcc-dg.exp | 8 +--
gcc/testsuite/lib/gfortran-dg.exp | 4 +
gcc/testsuite/lib/lto.exp | 9 ++-
27 files changed, 173 insertions(+), 158 deletions(-)
create mode 100644 gcc/testsuite/lib/fortran-modules.exp
@@ -2107,8 +2107,39 @@ Removes coverage data files generated for this test.
@item cleanup-ipa-dump @var{suffix}
Removes IPA dump files generated for this test.
-@item cleanup-modules
-Removes Fortran module files generated for this test.
+@item cleanup-modules "@var{list-of-extra-modules}"
+Removes Fortran module files generated for this test, excluding the
+module names listed in keep-modules.
+Cleaning up module files is usually done automatically by the testsuite
+by looking at the source files and removing the modules after the test
+has been executed.
+@smallexample
+module MoD1
+end module MoD1
+module Mod2
+end module Mod2
+module moD3
+end module moD3
+module mod4
+end module mod4
+! @{ dg-final @{ cleanup-modules "mod1 mod2" @} @} ! redundant
+! @{ dg-final @{ keep-modules "mod3 mod4" @} @}
+@end smallexample
+
+@item keep-modules "@var{list-of-modules-not-to-delete}"
+Whitespace separated list of module names that should not be deleted by
+cleanup-modules.
+If the list of modules is empty, all modules defined in this file are kept.
+@smallexample
+module maybe_unneeded
+end module maybe_unneeded
+module keep1
+end module keep1
+module keep2
+end module keep2
+! @{ dg-final @{ keep-modules "keep1 keep2" @} @} ! just keep these two
+! @{ dg-final @{ keep-modules "" @} @} ! keep all
+@end smallexample
@item cleanup-profile-file
Removes profiling files generated for this test.
@@ -6,5 +6,4 @@ module binding_label_tests_10
implicit none
integer(c_int), bind(c,name="c_one") :: one
end module binding_label_tests_10
-
-! Do not use dg-final to cleanup-modules
+! { dg-final { keep-modules "" } }
@@ -11,5 +11,4 @@ program main
use binding_label_tests_10 ! { dg-error "collides" }
use binding_label_tests_10_main
end program main
-
-! { dg-final { cleanup-modules "binding_label_tests_10_main binding_label_tests_10" } }
+! { dg-final { cleanup-modules "binding_label_tests_10" } }
@@ -10,5 +10,4 @@ contains
one = 1
end function one
end module binding_label_tests_11
-
-! Do not use dg-final to cleanup-modules
+! { dg-final { keep-modules "" } }
@@ -15,5 +15,4 @@ program main
use binding_label_tests_11 ! { dg-error "collides" }
use binding_label_tests_11_main
end program main
-
-! { dg-final { cleanup-modules "binding_label_tests_11_main binding_label_tests_11" } }
+! { dg-final { cleanup-modules "binding_label_tests_11" } }
@@ -6,3 +6,4 @@ module binding_label_tests_13
integer(c_int) :: c3
bind(c) c3
end module binding_label_tests_13
+! { dg-final { keep-modules "" } }
@@ -12,5 +12,4 @@ contains
use binding_label_tests_13 ! { dg-error "collides" }
end subroutine c_sub
end module binding_label_tests_13_main
-! { dg-final { cleanup-modules "binding_label_tests_13 binding_label_tests_13_main" } }
-
+! { dg-final { cleanup-modules "binding_label_tests_13" } }
@@ -26,3 +26,4 @@ contains
end function basicGet
end module G_Nodes
+! { dg-final { keep-modules "" } }
@@ -12,3 +12,4 @@ module m
type t
end type t
end module m
+! { dg-final { keep-modules "m" } }
@@ -13,3 +13,4 @@ module m2
type, extends(t) :: t2
end type t2
end module m2
+! { dg-final { keep-modules "m2" } }
@@ -27,5 +27,4 @@
end select
print *, i
end
-
-! { dg-final { cleanup-modules "m m2 m3" } }
+! { dg-final { cleanup-modules "m m2" } }
@@ -61,15 +61,18 @@ foreach test [lsort [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ]]
set option_list [list { -O2 } ]
set nshort [file tail [file dirname $test]]/[file tail $test]
+ list-module-names $test
foreach flags $option_list {
verbose "Testing $nshort (single), $flags" 1
dg-test $test "-fcoarray=single $flags" ""
+ cleanup-modules ""
}
foreach flags $option_list {
verbose "Testing $nshort (libcaf_single), $flags" 1
dg-test $test "-fcoarray=lib $flags -lcaf_single" ""
+ cleanup-modules ""
}
}
torture-finish
@@ -12,4 +12,4 @@ module test_common_binding_labels_2
integer(c_int) :: i
bind(c, name="") /com2/
end module test_common_binding_labels_2
-
+! { dg-final { keep-modules "" } }
@@ -21,5 +21,4 @@ program main
use test_common_binding_labels_2 ! { dg-error "does not match" }
use test_common_binding_labels_2_main
end program main
-
-! { dg-final { cleanup-modules "test_common_binding_labels_2_main test_common_binding_labels_2" } }
+! { dg-final { cleanup-modules "test_common_binding_labels_2" } }
@@ -8,3 +8,4 @@ module test_common_binding_labels_3
real(c_double) :: s
bind(c, name="my_common_block") :: /mycom/
end module test_common_binding_labels_3
+! { dg-final { keep-modules "" } }
@@ -10,5 +10,4 @@ program main
use test_common_binding_labels_3_main
use test_common_binding_labels_3 ! { dg-error "collides" }
end program main
-
-! { dg-final { cleanup-modules "test_common_binding_labels_3_main test_common_binding_labels_3" } }
+! { dg-final { cleanup-modules "test_common_binding_labels_3" } }
@@ -10,3 +10,4 @@ module iso_red
end type varying_string
end module iso_red
! DO NOT CLEAN UP THE MODULE FILE - whole_file_29.f90 does it.
+! { dg-final { keep-modules "" } }
@@ -24,4 +24,4 @@ contains
end subroutine syntax_init_from_ifile
end module syntax_rules
end
-! { dg-final { cleanup-modules "syntax_rules ifiles iso_red" } }
+! { dg-final { cleanup-modules "iso_red" } }
@@ -13,3 +13,4 @@ module system_defs_m
end type sysvector_t
end module system_defs_m
! DO NOT CLEAN UP THE MODULE FILE - whole_file_31.f90 does it.
+! { dg-final { keep-modules "" } }
@@ -18,4 +18,4 @@ program t
type(sysvector_t), target :: sol
solution => sol
end program t
-! { dg-final { cleanup-modules "system_defs_m convecreac_m" } }
+! { dg-final { cleanup-modules "system_defs_m" } }
@@ -28,7 +28,7 @@ load_lib torture-options.exp
torture-init
set-torture-options [get-fortran-torture-options]
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f]] {
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ]] {
# If we're only testing specific files and this isn't one of them, skip it.
if ![runtest_file_p $runtests $testcase] then {
continue
@@ -36,67 +36,4 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f]] {
fortran-torture $testcase
}
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f90]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F90]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F95]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f03]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F03]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f08]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F08]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture $testcase
-}
-
torture-finish
@@ -32,7 +32,7 @@ load_lib torture-options.exp
torture-init
set-torture-options [get-fortran-torture-options]
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f]] {
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ]] {
# If we're only testing specific files and this isn't one of them, skip it.
if ![runtest_file_p $runtests $testcase] then {
continue
@@ -40,67 +40,4 @@ foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f]] {
fortran-torture-execute $testcase
}
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture-execute $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f90]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture-execute $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F90]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture-execute $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f95]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture-execute $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F95]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture-execute $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f03]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture-execute $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F03]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture-execute $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.f08]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture-execute $testcase
-}
-
-foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.F08]] {
- if ![runtest_file_p $runtests $testcase] then {
- continue
- }
- fortran-torture-execute $testcase
-}
-
torture-finish
new file mode 100644
@@ -0,0 +1,98 @@
+# Copyright (C) 2012 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# helper to deal with fortran modules
+
+# Remove files for specified Fortran modules.
+proc cleanup-modules { modlist } {
+ global clean
+ foreach mod [concat $modlist $clean] {
+ set m [string tolower $mod].mod
+ verbose "cleanup-module `$m'" 2
+ if [is_remote host] {
+ remote_file host delete $m
+ }
+ remote_file build delete $m
+ }
+}
+
+proc keep-modules { modlist } {
+ global clean
+ # if the modlist is empty, keep everything
+ if {[llength $modlist] < 1} {
+ set clean {}
+ } else {
+ set cleansed {}
+ foreach cl $clean {
+ if {[lsearch $cl $modlist] < 0} {
+ lappend cleansed $cl
+ }
+ }
+ if {[llength $clean] == [llength $cleansed]} {
+ warning "keep-modules had no effect?! Possible typo in module name."
+ }
+ set clean $cleansed
+ }
+}
+
+# collect all module names from a source-file
+proc list-module-names { files } {
+ global clean
+ set clean {}
+ foreach file $files {
+ foreach mod [list-module-names-1 $file] {
+ if {[lsearch $clean $mod] < 0} {
+ lappend clean $mod
+ }
+ }
+ }
+ return [join $clean " "]
+}
+
+proc list-module-names-1 { file } {
+ 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 {![string match "" $tmp]} {
+ foreach i $tmp {
+ regexp "(\[0-9\]+)\[ \t\]+(?:(?:#)?\[ \t\]*include\[ \t\]+)\[\"\](\[^\"\]*)\[\"\]" $i dummy lineno include_file
+ if {[info exists include_file]} {
+ set dir [file dirname $file]
+ set inc "$dir/$include_file"
+ unset include_file
+ if {![file readable $inc]} {
+ warning "Line $lineno includes unreadable file `$inc'"
+ continue
+ }
+ verbose "Line $lineno includes `$inc'" 3
+ foreach mod [list-module-names-1 $inc] {
+ if {[lsearch $result $mod] < 0} {
+ lappend result $mod
+ }
+ }
+ 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
+ if {![info exists lineno]} {
+ continue
+ }
+ verbose "Line $lineno mentions module `$mod'" 3
+ if {[lsearch $result $mod] < 0} {
+ lappend result $mod
+ }
+ }
+ }
+ return $result
+}
@@ -21,6 +21,7 @@
# based on f-torture.exp, which was written by Rob Savoye.
load_lib target-supports.exp
+load_lib fortran-modules.exp
# Return the list of options to use for fortran torture tests.
# The default option list can be overridden by
@@ -218,6 +219,7 @@ proc fortran-torture-execute { src } {
if [string match "/*" $testcase] {
set testcase "[file tail [file dirname $src]]/[file tail $src]"
}
+ list-module-names $src
# Walk the list of options and copmile and run the testcase for all
# options that are not explicitly disabled by the .x script (if present).
@@ -332,6 +334,7 @@ proc fortran-torture-execute { src } {
}
$status "$testcase execution, $option"
}
+ cleanup-modules ""
}
@@ -390,7 +393,8 @@ proc fortran-torture { args } {
return
}
}
-
+ list-module-names $src
+
# loop through all the options
set option_list $torture_with_loops
foreach option $option_list {
@@ -406,6 +410,7 @@ proc fortran-torture { args } {
}
fortran-torture-compile $src "$option $options"
+ cleanup-modules ""
}
}
@@ -29,6 +29,7 @@ load_lib prune.exp
load_lib libgloss.exp
load_lib target-libpath.exp
load_lib torture-options.exp
+load_lib fortran-modules.exp
# We set LC_ALL and LANG to C so that we get the same error messages as expected.
setenv LC_ALL C
@@ -573,13 +574,6 @@ proc cleanup-saved-temps { args } {
}
}
-# Remove files for specified Fortran modules.
-proc cleanup-modules { modlist } {
- foreach modname $modlist {
- remove-build-file [string tolower $modname].mod
- }
-}
-
# Scan Fortran modules for a given regexp.
#
# Argument 0 is the module name
@@ -111,10 +111,12 @@ proc gfortran-dg-runtest { testcases default-extra-flags } {
}
set nshort [file tail [file dirname $test]]/[file tail $test]
+ list-module-names $test
foreach flags $option_list {
verbose "Testing $nshort, $flags" 1
dg-test $test $flags ${default-extra-flags}
+ cleanup-modules ""
}
}
@@ -171,6 +173,7 @@ proc gfortran-dg-debug-runtest { target_compile trivial opt_opts testcases } {
}
set nshort [file tail [file dirname $test]]/[file tail $test]
+ list-module-names $test
foreach flags $DEBUG_TORTURE_OPTIONS {
set doit 1
@@ -179,6 +182,7 @@ proc gfortran-dg-debug-runtest { target_compile trivial opt_opts testcases } {
if { $doit } {
verbose -log "Testing $nshort, $flags" 1
dg-test $test $flags ""
+ cleanup-modules ""
}
}
}
@@ -499,7 +499,10 @@ proc lto-execute { src1 sid } {
verbose "$testcase not supported on this target, skipping it" 3
return
}
-
+ # Should be safe for non-fortran too but be paranoid..
+ if {$sid eq "f_lto"} {
+ list-module-names $src_list
+ }
regsub "_0.*" $testcase "" testcase
# Set up the base name of executable files so they'll be unique.
@@ -578,6 +581,10 @@ proc lto-execute { src1 sid } {
|| ![string compare "link" $compile_type] } {
file_on_host delete $execname
}
+ # Should be safe for non-fortran too but be paranoid..
+ if {$sid eq "f_lto"} {
+ cleanup-modules ""
+ }
}
}
--
1.7.9.1