find/testsuite/config/unix.exp

   1 # -*- TCL -*-
   2 # Test-specific TCL procedures required by DejaGNU.
   3 # Copyright (C) 2000, 2003, 2004, 2005, 2006, 2010, 2011 Free Software
   4 # Foundation, Inc.
   5 #
   6 # This program is free software: you can redistribute it and/or modify
   7 # it under the terms of the GNU General Public License as published by
   8 # the Free Software Foundation, either version 3 of the License, or
   9 # (at your option) any later version.
  10 #
  11 # This program is distributed in the hope that it will be useful,
  12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 # GNU General Public License for more details.
  15 #
  16 # You should have received a copy of the GNU General Public License
  17 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 # Modified by Kevin Dalley <kevind@rahul.net> from the xargs files.
  20 # Modified by David MacKenzie <djm@gnu.ai.mit.edu> from the gcc files
  21 # written by Rob Savoye <rob@cygnus.com>.
  22 \f
  23
  24 global OLDFIND
  25 global FTSFIND
  26
  27 verbose "base_dir is $base_dir" 2
  28 global env;
  29 set env(GNU_FINDUTILS_FD_LEAK_CHECK) "1"
  30
  31 # look for OLDFIND and FTSFIND
  32 if { ![info exists OLDFIND] || ![info exists FTSFIND] } {
  33     verbose "Searching for oldfind"
  34     set dir "$base_dir/.."
  35
  36     set objfile "find.o"
  37     if ![file exists "$dir/$objfile"] then {
  38         error "dir is $dir, but I cannot see $objfile in that directory"
  39     }
  40     if ([findfile $dir/oldfind 1 0]) {
  41         verbose "found oldfind, so ftsfind must be called find"
  42         set OLDFIND [findfile $dir/oldfind $dir/oldfind [transform oldfind]]
  43         set FTSFIND [findfile $dir/find    $dir/find    [transform find   ]]
  44     } else {
  45         verbose "did not find oldfind, so ftsfind must be called ftsfind"
  46         set OLDFIND [findfile $dir/find    $dir/find    [transform find   ]]
  47         set FTSFIND [findfile $dir/ftsfind $dir/ftsfind [transform ftsfind]]
  48     }
  49 }
  50
  51 verbose "ftsfind is at $FTSFIND" 2
  52 verbose "oldfind is at $OLDFIND" 2
  53
  54 if { [ string equal $FTSFIND $OLDFIND ] } {
  55     error "OLDFIND and FTSFIND are set to $FTSFIND, which can't be right"
  56 }
  57
  58 if [file exists $FTSFIND] then {
  59     if [file exists $OLDFIND] then {
  60         verbose "FTSFIND=$FTSFIND and OLDFIND=$OLDFIND both exist." 2
  61     } else {
  62         error "OLDFIND=$OLDFIND, but that program does not exist"
  63     }
  64 } else {
  65     error "FTSFIND=$FTSFIND, but that program does not exist (base_dir is $base_dir)"
  66 }
  67
  68
  69 global FINDFLAGS
  70 if ![info exists FINDFLAGS] then {
  71     set FINDFLAGS ""
  72 }
  73
  74 # Called by runtest.
  75 # Extract and print the version number of find.
  76 proc find_version {} {
  77     global FTSFIND
  78     global FINDFLAGS
  79
  80     if {[which $FTSFIND] != 0} then {
  81         set tmp [ eval exec $FTSFIND $FINDFLAGS --version </dev/null | sed 1q ]
  82         clone_output $tmp
  83     } else {
  84         warning "$FTSFIND, program does not exist"
  85     }
  86 }
  87
  88 # Run find
  89 # Called by individual test scripts.
  90 proc do_find_start { suffix findprogram flags passfail options infile output } {
  91     global verbose
  92
  93     set scriptname [uplevel {info script}]
  94     set testbase [file rootname $scriptname]
  95
  96
  97     if { [string match "f*" $passfail] } {
  98         set fail_good 1
  99     } else {
 100         if { [string match "p*" $passfail] } {
 101             set fail_good 0
 102         } else {
 103             if { [string match "xf*" $passfail] } {
 104                 setup_xfail "*-*-*"
 105                 set fail_good 1
 106             } else {
 107                 if { [string match "xp*" $passfail] } {
 108                     setup_xfail "*-*-*"
 109                     set fail_good 0
 110                 } else {
 111                     # badly formed
 112                     untested "Badly defined test"
 113                     error "The first argument to find_start was $passfail but it should begin with p (pass) or f (fail) or xf (should fail but we know it passes) or xp (should pass but we know it fails)"
 114                 }
 115             }
 116         }
 117     }
 118
 119     set test [file tail $testbase]
 120     set testname "$test.$suffix"
 121
 122     # set compareprog "cmp"
 123     set compareprog "diff -u"
 124
 125     set tmpout ""
 126     if { $output != "" } {
 127         error "The output option is not supported yet"
 128     }
 129
 130     set outfile "$testbase.xo"
 131     if {$infile != ""} then {
 132         set infile "[file dirname [file dirname $testbase]]/inputs/$infile"
 133     } else {
 134         set infile /dev/null
 135     }
 136
 137     set cmd "$findprogram $flags $options < $infile > find.out.uns"
 138     send_log "$cmd\n"
 139     if $verbose>1 then {
 140         send_user "Spawning \"$cmd\"\n"
 141     }
 142
 143     if $fail_good then {
 144         send_log "Hoping for this command to return nonzero\n"
 145     } else {
 146         send_log "Hoping for this command to return 0\n"
 147     }
 148     set failed [ catch "exec $cmd" result ]
 149     send_log "return value is $failed, result is '$result'\n"
 150     if $failed {
 151         # The command failed.
 152         if $fail_good then {
 153             send_log "As expected, $cmd returned nonzero\n"
 154         } else {
 155             fail "$testname, $result"
 156         }
 157     } else {
 158         # The command returned 0.
 159         if $fail_good then {
 160             fail "$testname, $result"
 161         } else {
 162             send_log "As expected, $cmd returned 0\n"
 163         }
 164     }
 165
 166     exec sort < find.out.uns > find.out
 167     file delete find.out.uns
 168
 169     if [file exists $outfile] then {
 170         # We use the 'sort' above to sort the output of find to ensure
 171         # that the directory entries appear in a predictable order.
 172         # Because in the general case the person compiling and running
 173         # "make check" will have a different collating order to the
 174         # maintainer, we can't guarantee that our "correct" answer
 175         # is already sorted in the correct order.  To avoid trying
 176         # to figure out how to select a POSIX environment on a
 177         # random system, we just sort the data again here, using
 178         # the local user's environment.
 179         exec sort < $outfile > cmp.out
 180         set cmp_cmd "$compareprog find.out cmp.out"
 181
 182         send_log "$cmp_cmd\n"
 183         catch "exec $cmp_cmd" cmpout
 184         if {$cmpout != ""} then {
 185             fail "$testname, standard output differs from the expected result:\n$cmpout"
 186             return
 187         }
 188     } else {
 189         if {[file size find.out] != 0} then {
 190             fail "$testname, output should be empty"
 191             return
 192         }
 193     }
 194     pass "$testname"
 195 }
 196
 197 proc optimisation_levels_to_test {} {
 198     global OPTIMISATION_LEVELS
 199     if [info exists OPTIMISATION_LEVELS] {
 200         send_log "Running find at optimisation levels $OPTIMISATION_LEVELS\n"
 201         return $OPTIMISATION_LEVELS
 202     } else {
 203         send_log "Running find at default optimisation levels\n"
 204         return {0 1 2 3}
 205     }
 206 }
 207
 208 proc find_start { passfail options {infile ""} {output ""} {setup ""}} {
 209     global OLDFIND
 210     global FTSFIND
 211     global FINDFLAGS
 212     global SKIP_OLD
 213     global SKIP_NEW
 214
 215     if {$infile != ""} then {
 216         set msg "Did not expect infile parameter to be set"
 217         untested $msg
 218         error $msg
 219     }
 220
 221     if {[which $FTSFIND] == 0} then {
 222         error "$FTSFIND, program does not exist"
 223         exit 1
 224     }
 225     if {[which $OLDFIND] == 0} then {
 226         error "$OLDFIND, program does not exist"
 227         exit 1
 228     }
 229
 230     # Now run the test with each binary, once with each optimisation level.
 231     foreach optlevel [optimisation_levels_to_test] {
 232         set flags "$FINDFLAGS -O$optlevel"
 233         if { ![info exists SKIP_OLD] || ! $SKIP_OLD } {
 234             eval $setup
 235             do_find_start old-O$optlevel  $OLDFIND $flags $passfail $options $infile $output
 236         }
 237         if { ![info exists SKIP_NEW] || !$SKIP_NEW } {
 238             eval $setup
 239             do_find_start new-O$optlevel  $FTSFIND $flags $passfail $options $infile $output
 240         }
 241     }
 242 }
 243
 244 # Called by runtest.
 245 # Clean up (remove temporary files) before runtest exits.
 246 proc find_exit {} {
 247     catch "exec rm -f find.out cmp.out"
 248 }
 249
 250 proc path_setting_is_unsafe {} {
 251     global env;
 252     set itemlist [ split $env(PATH) : ]
 253     foreach item $itemlist {
 254         if { [ string equal $item "" ] } {
 255             return 1;
 256         }
 257         if { [ string equal $item "." ] } {
 258             return 1;
 259         }
 260         if { ! [ string match "/*" $item ] } {
 261             # not an absolute path element.
 262             return 1
 263         }
 264     }
 265     return 0;
 266 }
 267
 268 proc touch args {
 269     foreach filename $args {
 270         set f [open "$filename" "a"]
 271         close $f
 272     }
 273 }
 274
 275 proc mkdir { dirname } {
 276     # Not all versions of Tcl offer 'file mkdir'.
 277     set failed [ catch "file mkdir $dirname" result ]
 278     if $failed {
 279         # Fall back on the external command.
 280         send_log "file mkdir does not work, falling back on exec mkdir\n"
 281         exec mkdir "$dirname"
 282     }
 283 }
 284
 285
 286 proc safe_path [ ] {
 287     if { [ path_setting_is_unsafe ] } {
 288         warning { Cannot perform test as your $PATH environment variable includes a reference to the current directory or a directory name which is not absolute }
 289         untested { skipping this test because your $PATH variable is wrongly set }
 290         return 0
 291     } else {
 292         return 1
 293     }
 294 }
 295
 296
 297 proc fs_superuser [ ] {
 298     set tmpfile "tmp000"
 299     exec rm -f $tmpfile
 300     touch $tmpfile
 301     exec chmod 000 $tmpfile
 302     set retval 0
 303
 304     if [ file readable $tmpfile ] {
 305         # On Cygwin, a user with admin rights can read all files, and
 306         # access(foo,R_OK) correctly returns 1 for all files.
 307         warning "You have superuser privileges, skipping this test."
 308         untested {skipping this test because you have superuser privileges}
 309         set retval 1
 310     }
 311     exec rm -f $tmpfile
 312     return $retval
 313 }