tm_ext_cmds.tcl

   1
   2 set TM_PLATFORM "$TM_OPSYS-$TM_MACHINE_ARCH"
   3
   4 # Check if a variable var is defined
   5 proc defined {var} {
   6         if {[uplevel "info exists $var"]} {
   7                 return 1
   8         } else {
   9                 return 0
  10         }
  11 }
  12
  13 # True if target is the current goal
  14 proc make {target} {
  15         global TM_CURRENT_GOAL
  16
  17         if {"$target" eq "$TM_CURRENT_GOAL"} {
  18                 return 1
  19         } else {
  20                 return 0
  21         }
  22 }
  23
  24 # True if operand is the empty string
  25 proc empty {operand} {
  26         if {[string length $operand]} {
  27                 return 0
  28         } else {
  29                 return 1
  30         }
  31 }
  32
  33 # Check if an array a contains a value for key
  34 proc array_has {a key} {
  35         if {[string length [uplevel "array get $a $key"]]} {
  36                 return 1
  37         } else {
  38                 return 0
  39         }
  40 }
  41
  42 # Set a global parameter var to val using mode mode
  43 proc param {var val} {
  44         global TM_PARAM
  45         global TM_ENV_LOOKUP
  46         global env
  47
  48         if {[array_has TM_PARAM $var]} {
  49                 uplevel "set $var {$TM_PARAM($var)}"
  50         } elseif {[info exists TM_ENV_LOOKUP]} {
  51                 uplevel "set $var {$env($var)}"
  52         } else {
  53                 uplevel "set $var {$val}"
  54         }
  55 }
  56
  57 # Clean up a list of options to make it suitable for exec
  58 proc options {str} {
  59         set OPTIONS [split $str "\n"]
  60         set TRIMOPTS {}
  61         foreach OPT $OPTIONS {
  62                 set trim [string trim $OPT]
  63                 if {[string length $trim]} {
  64                         lappend TRIMOPTS $trim
  65                 }
  66         }
  67         return $TRIMOPTS
  68 }
  69
  70 rename exec tcl::exec
  71
  72 proc exec args {
  73         global TM_NO_EXECUTE
  74         global TM_SILENT_MODE
  75         set flags ""
  76         set echo 1
  77         set errexit 1
  78         set noexec 0
  79         set start 0
  80
  81         if {[defined TM_NO_EXECUTE]} {
  82                 set noexec $TM_NO_EXECUTE
  83         }
  84
  85         if {[llength args] == 0} {
  86                 return "";
  87         }
  88
  89         if {"[lindex $args 0]" eq "-flags"} {
  90                 if {[llength $args] < 2} {
  91                         error "No flags provided to -flags"
  92                 }
  93                 set flags [lindex $args 1]
  94                 set start 2
  95         }
  96
  97         for {set i 0} {$i < [string length $flags]} {incr i} {
  98                 switch [string index $flags $i] {
  99                         "@" {set echo 0}
 100                         "-" {set errexit 0}
 101                         "+" {set noexec 0}
 102                         default {error "Unknown flag given to exec: [string index $i]"}
 103                 }
 104         }
 105
 106         set rest [lrange $args $start end]
 107
 108         if {$echo && ![defined TM_SILENT_MODE]} {
 109                 # Do it this way to avoid having Tcl escape quotes and such
 110                 # in the output.
 111                 foreach arg [lrange $rest 0 end-1] {
 112                         puts -nonewline "$arg "
 113                 }
 114                 puts "[lrange $rest end end]"
 115                 flush stdout
 116         }
 117
 118         if {$noexec} {
 119                 return ""
 120         }
 121
 122         if {![defined TM_SILENT_MODE]} {
 123                 set childpid [tcl::exec {*}$rest &]
 124                 set status [os.wait $childpid]    ;# TODO: This might not work on Windows...
 125
 126                 if {"[lindex $status 1]" eq "exit" && [lindex $status 2] != 0} {
 127                         if {$errexit} {
 128                                 error "exec returned non-zero return code: $status"
 129                         }
 130                 } elseif {"[lindex $status 1]" ne "exit"} {
 131                         if {$errexit} {
 132                                 error "exec terminated abnormally: $status"
 133                         }
 134                 }
 135         } else {
 136                 try {
 137                         tcl::exec {*}$rest
 138                 } on CHILDSTATUS {pid code} {
 139                         error "exec returned non-zero return code: $code"
 140                 } on CHILDKILLED {pid sig msg} {
 141                         error "exec terminated abnormally: $msg"
 142                 } on CHILDSUSP   {pid sig msg} {
 143                         error "exec suspended: $msg"
 144                 }
 145         }
 146
 147         return ""
 148 }
 149
 150
 151 # Take a list of filenames and replace the extensions that match x with y
 152 proc replace-ext {files x y} {
 153         set ys {}
 154         foreach f $files {
 155                 if {"[file extension $f]" eq "$x"} {
 156                         lappend ys "[file rootname $f]$y"
 157                 } else {
 158                         lappend ys $f
 159                 }
 160         }
 161         return $ys
 162 }
 163
 164
 165 # Define a substitution rule.  Returns a list of all the targets created.
 166 proc sub {from to recipe} {
 167         set OUT {}
 168
 169         foreach in [glob *$from] {
 170                 set out [replace-ext $in $from $to]
 171                 rule $out $in $recipe
 172                 lappend OUT $out
 173         }
 174
 175         return $OUT
 176 }
 177
 178 # Create a list of filenames with dir prepended to a given list of filenames
 179 proc in-dir {dir files} {
 180         set newfiles {}
 181         foreach f $files {
 182                 lappend newfiles [file join $dir $f]
 183         }
 184         return $newfiles
 185 }
 186