gcc/testsuite/lib/fortran-modules.exp

   1 #   Copyright (C) 2012 Free Software Foundation, Inc.
   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.
  20 proc cleanup-modules { modlist } {
  21     global clean
  22     foreach mod [concat $modlist $clean] {
  23         set m [string tolower $mod].mod
  24         verbose "cleanup-module `$m'" 2
  25         if [is_remote host] {
  26             remote_file host delete $m
  27         }
  28         remote_file build delete $m
  29     }
  30 }
  31
  32 proc keep-modules { modlist } {
  33     global clean
  34     # if the modlist is empty, keep everything
  35     if {[llength $modlist] < 1} {
  36         set clean {}
  37     } else {
  38         set cleansed {}
  39         foreach cl $clean {
  40             if {[lsearch $cl $modlist] < 0} {
  41                 lappend cleansed $cl
  42             }
  43         }
  44         if {[llength $clean] == [llength $cleansed]} {
  45             warning "keep-modules had no effect?! Possible typo in module name."
  46         }
  47         set clean $cleansed
  48     }
  49 }
  50
  51 # collect all module names from a source-file
  52 proc list-module-names { files } {
  53     global clean
  54     set clean {}
  55     foreach file $files {
  56         foreach mod [list-module-names-1 $file] {
  57             if {[lsearch $clean $mod] < 0} {
  58                 lappend clean $mod
  59             }
  60         }
  61     }
  62     return [join $clean " "]
  63 }
  64
  65 proc list-module-names-1 { file } {
  66     set result {}
  67     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]
  68     if {![string match "" $tmp]} {
  69         foreach i $tmp {
  70             regexp "(\[0-9\]+)\[ \t\]+(?:(?:#)?\[ \t\]*include\[ \t\]+)\[\"\](\[^\"\]*)\[\"\]" $i dummy lineno include_file
  71             if {[info exists include_file]} {
  72                 set dir [file dirname $file]
  73                 set inc "$dir/$include_file"
  74                 unset include_file
  75                 if {![file readable $inc]} {
  76                     # We do not currently use include path search logic, punt
  77                     continue
  78                 }
  79                 verbose "Line $lineno includes `$inc'" 3
  80                 foreach mod [list-module-names-1 $inc] {
  81                     if {[lsearch $result $mod] < 0} {
  82                         lappend result $mod
  83                     }
  84                 }
  85                 continue
  86             }
  87             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
  88             if {![info exists lineno]} {
  89                 continue
  90             }
  91             verbose "Line $lineno mentions module `$mod'" 3
  92             if {[lsearch $result $mod] < 0} {
  93                 lappend result $mod
  94             }
  95         }
  96     }
  97     return $result
  98 }