gcc/testsuite/lib/fortran-modules.exp

   1 #   Copyright (C) 2012-2016 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 # This includes both .mod and .smod files.
  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     }
  31     cleanup-submodules $modlist
  32 }
  33
  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
  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]} {
  91                     # We do not currently use include path search logic, punt
  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 }