This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [PATCH, gfortran] Cleanup the submodule tests
I am currently testing the following patch that handle both modules and submodules. It is a little bit clumsy and may not handle all the possible syntax variants. Any comment welcomed!-) Testing in progress.
Dominique
--- ../_clean/gcc/testsuite/lib/fortran-modules.exp 2017-01-01 17:38:58.000000000 +0100
+++ gcc/testsuite/lib/fortran-modules.exp 2017-04-16 01:16:25.000000000 +0200
@@ -79,10 +79,11 @@ proc list-module-names { files } {
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 {[file isdirectory $file]} {return}
+ set tmp [igrep $file "^\\s*((#)?\\s*include|(sub)?module(?!\\s+(recursive\\s+)?(procedure|subroutine|function)\\s*))\\s*.*" line]
if {![string match "" $tmp]} {
foreach i $tmp {
- regexp "(\[0-9\]+)\[ \t\]+(?:(?:#)?\[ \t\]*include\[ \t\]+)\[\"\](\[^\"\]*)\[\"\]" $i dummy lineno include_file
+ regexp -nocase "(\[0-9\]+)\\s+(?:(?:#)?\\s*include\\s+)\[\"\'\](\[^\"\'\]*)\[\"\'\]" $i dummy lineno include_file
if {[info exists include_file]} {
set dir [file dirname $file]
set inc "$dir/$include_file"
@@ -99,7 +100,11 @@ proc list-module-names-1 { file } {
}
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 "(\[0-9\]+)\\s+(module|submodule)\\s*(\[^;\]*)" $i i lineno keyword mod
+ regsub "\\s*!.*" $mod "" mod
+ regsub ":\[^)\]*" $mod "" mod
+ regsub "\\(\\s*" $mod "" mod
+ regsub "\\s*\\)\\s*" $mod "@" mod
if {![info exists lineno]} {
continue
}
@@ -111,3 +116,54 @@ proc list-module-names-1 { file } {
}
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
+}
> Le 15 avr. 2017 à 18:50, Janus Weil <janus@gcc.gnu.org> a écrit :
>
> 2017-04-15 17:54 GMT+02:00 Dominique d'Humières <dominiq@lps.ens.fr>:
>>>> This is indeed doable, but before I’ld like to improve the module cleanup with the following patch
>>>
>>> Yes, looks very useful to me (makes the regexps much more compact &
>>> readable). In addition, couldn't one use \s for whitespace instead of
>>> \[ \t\] ?
>>
>> I have posted what I have in my working tree. I’ll test the use of \s instead of \[ \t\] . Is it really portable?
>
> Not sure. But at least some of the other files in gcc/testsuite/lib
> seem to use \s as well (e.g. gcc-dg.exp).
>
>
>>> I assume your igrep is just a copy of dejagnu's grep with an additional -nocase?
>>
>> Yes!
>
> Ok to commit from my side, if you have tested that it works properly.
>
> Cheers,
> Janus