]>
Commit | Line | Data |
---|---|---|
f1717362 | 1 | # Copyright (C) 2012-2016 Free Software Foundation, Inc. |
4c4cd94d | 2 | |
3 | # This program is free software; you can redistribute it and/or modify | |
4 | # it under the terms of the GNU General Public License as published by | |
5 | # the Free Software Foundation; either version 3 of the License, or | |
6 | # (at your option) any later version. | |
7 | # | |
8 | # This program is distributed in the hope that it will be useful, | |
9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | # GNU General Public License for more details. | |
12 | # | |
13 | # You should have received a copy of the GNU General Public License | |
14 | # along with GCC; see the file COPYING3. If not see | |
15 | # <http://www.gnu.org/licenses/>. | |
16 | ||
17 | # helper to deal with fortran modules | |
18 | ||
19 | # Remove files for specified Fortran modules. | |
c8ddfd5d | 20 | # This includes both .mod and .smod files. |
4c4cd94d | 21 | proc cleanup-modules { modlist } { |
22 | global clean | |
23 | foreach mod [concat $modlist $clean] { | |
24 | set m [string tolower $mod].mod | |
25 | verbose "cleanup-module `$m'" 2 | |
26 | if [is_remote host] { | |
27 | remote_file host delete $m | |
28 | } | |
29 | remote_file build delete $m | |
30 | } | |
c8ddfd5d | 31 | cleanup-submodules $modlist |
4c4cd94d | 32 | } |
33 | ||
df8f279f | 34 | # Remove files for specified Fortran submodules. |
35 | proc cleanup-submodules { modlist } { | |
36 | global clean | |
37 | foreach mod [concat $modlist $clean] { | |
38 | set m [string tolower $mod].smod | |
39 | verbose "cleanup-submodule `$m'" 2 | |
40 | if [is_remote host] { | |
41 | remote_file host delete $m | |
42 | } | |
43 | remote_file build delete $m | |
44 | } | |
45 | } | |
46 | ||
4c4cd94d | 47 | proc keep-modules { modlist } { |
48 | global clean | |
49 | # if the modlist is empty, keep everything | |
50 | if {[llength $modlist] < 1} { | |
51 | set clean {} | |
52 | } else { | |
53 | set cleansed {} | |
54 | foreach cl $clean { | |
55 | if {[lsearch $cl $modlist] < 0} { | |
56 | lappend cleansed $cl | |
57 | } | |
58 | } | |
59 | if {[llength $clean] == [llength $cleansed]} { | |
60 | warning "keep-modules had no effect?! Possible typo in module name." | |
61 | } | |
62 | set clean $cleansed | |
63 | } | |
64 | } | |
65 | ||
66 | # collect all module names from a source-file | |
67 | proc list-module-names { files } { | |
68 | global clean | |
69 | set clean {} | |
70 | foreach file $files { | |
71 | foreach mod [list-module-names-1 $file] { | |
72 | if {[lsearch $clean $mod] < 0} { | |
73 | lappend clean $mod | |
74 | } | |
75 | } | |
76 | } | |
77 | return [join $clean " "] | |
78 | } | |
79 | ||
80 | proc list-module-names-1 { file } { | |
81 | set result {} | |
82 | 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] | |
83 | if {![string match "" $tmp]} { | |
84 | foreach i $tmp { | |
85 | regexp "(\[0-9\]+)\[ \t\]+(?:(?:#)?\[ \t\]*include\[ \t\]+)\[\"\](\[^\"\]*)\[\"\]" $i dummy lineno include_file | |
86 | if {[info exists include_file]} { | |
87 | set dir [file dirname $file] | |
88 | set inc "$dir/$include_file" | |
89 | unset include_file | |
90 | if {![file readable $inc]} { | |
8a46f880 | 91 | # We do not currently use include path search logic, punt |
4c4cd94d | 92 | continue |
93 | } | |
94 | verbose "Line $lineno includes `$inc'" 3 | |
95 | foreach mod [list-module-names-1 $inc] { | |
96 | if {[lsearch $result $mod] < 0} { | |
97 | lappend result $mod | |
98 | } | |
99 | } | |
100 | continue | |
101 | } | |
102 | 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 | |
103 | if {![info exists lineno]} { | |
104 | continue | |
105 | } | |
106 | verbose "Line $lineno mentions module `$mod'" 3 | |
107 | if {[lsearch $result $mod] < 0} { | |
108 | lappend result $mod | |
109 | } | |
110 | } | |
111 | } | |
112 | return $result | |
113 | } |