find/testsuite/config/unix.exp

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