locate/testsuite/config/unix.exp

   1 # -*- TCL -*-
   2 # Test-specific TCL procedures required by DejaGNU.
   3 # Copyright (C) 1994,2003,2004,2005,2006,2007 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
  19 # Modified by David MacKenzie <djm@gnu.org> from the gcc files
  20 # written by Rob Savoye <rob@cygnus.com>.
  21 \f
  22
  23 # use the local version of find for updatedb
  24 #
  25 # We normalise (normalize for those over the water) pathnames
  26 # because the updatedb shell script uses "cd", which means that
  27 # any relative paths no longer point where we thought they did.
  28 # Because "file normalize" requires tcl 8.4, we have a plan B
  29 # for normalising the name of a directory, but it is slower.
  30
  31 proc normalize_dir { dir } {
  32     if [ catch { file normalize $dir } result ] then {
  33         return [ exec /bin/sh -c "cd $dir && /bin/pwd" ]
  34     } else {
  35         return $result;
  36     }
  37 }
  38
  39 set fulldir [ normalize_dir "../../find" ]
  40 set env{find} "$fulldir/find"
  41
  42 # use the local help commands for updatedb
  43 set env(LIBEXECDIR) [ normalize_dir .. ]
  44 # use our local version of find, too.
  45
  46 # do not ignore any file systems for this test
  47 set env(PRUNEFS) ""
  48 global UPDATEDB
  49 global FRCODE
  50 global LOCATE
  51 global FIND
  52
  53 # look for binaries
  54 set UPDATEDB [findfile $base_dir/../updatedb     $base_dir/../updatedb     [transform updatedb]]
  55 set FRCODE   [findfile $base_dir/../frcode       $base_dir/../frcode       [transform frcode  ]]
  56 set LOCATE   [findfile $base_dir/../locate       $base_dir/../locate       [transform locate  ]]
  57 set FIND     [findfile $base_dir/../../find/find $base_dir/../../find/find [transform find    ]]
  58 verbose "UPDATEDB is $UPDATEDB" 1
  59 verbose "FRCODE   is $FRCODE" 1
  60 verbose "LOCATE   is $LOCATE" 1
  61 verbose "FIND     is $FIND" 1
  62
  63
  64 foreach exe "$UPDATEDB $FRCODE $LOCATE $FIND" {
  65     if ![ string match "/*" $exe ] {
  66         error "Failed to find a binary to test for $exe"
  67     }
  68 }
  69
  70 global UPDATEDBFLAGS
  71 if ![info exists UPDATEDBFLAGS] then {
  72     set UPDATEDBFLAGS ""
  73 }
  74
  75 set env(find) "$FIND"
  76
  77 global LOCATEFLAGS
  78 if ![info exists LOCATEFLAGS] then {
  79     set LOCATEFLAGS ""
  80 }
  81
  82 # Called by runtest.
  83 # Extract and print the version number of locate.
  84 proc locate_version {} {
  85     global UPDATEDB
  86     global UPDATEDBFLAGS
  87     global LOCATE
  88     global LOCATEFLAGS
  89
  90     if {[which $LOCATE] != 0} then {
  91         set tmp [ eval exec $LOCATE $LOCATEFLAGS --version </dev/null ]
  92         regexp "version.*$" $tmp version
  93         if [info exists version] then {
  94             clone_output "[which $LOCATE] $version\n"
  95         } else {
  96             warning "cannot get version from $tmp."
  97         }
  98     } else {
  99         warning "$LOCATE, program does not exist"
 100     }
 101 }
 102
 103
 104 # Run locate and leave the output in $comp_output.
 105 # Called by individual test scripts.
 106 proc locate_textonly { passfail id intext locateoptions outtext } {
 107     global LOCATE
 108     global FRCODE
 109
 110     set fail_good [string match "f*" $passfail]
 111
 112     set scriptname [uplevel {info script}]
 113     set testbase [file rootname $scriptname]
 114     set testname [file tail $testbase]
 115     set listfile "updatedb-paths.txt"
 116     set dbfile   "locate.db"
 117     set outfile  "locate.out"
 118
 119     # Generate the "frcode" input.
 120     catch { file delete -force $listfle }
 121     set f [open $listfile w]
 122     puts $f "$intext"
 123     close $f
 124
 125     # Run frcode
 126     exec $FRCODE < $listfile > $dbfile
 127
 128     # Now run locate.
 129     set locatecmd "$LOCATE -d $dbfile $locateoptions"
 130     send_log "Running $locatecmd \n"
 131     catch "exec $locatecmd > $outfile"
 132
 133     set result ""
 134     set f [open "$outfile" r]
 135     while { [ gets $f line ]  >= 0 } {
 136         # send_log "Output fragment is $line\n"
 137         append result "$line\n"
 138     }
 139     close $f
 140
 141     # send_log "Output is $result\n"
 142
 143     if {[string equal $result $outtext]} {
 144         if $fail_good then {
 145             fail "$testname-$id"
 146         } else {
 147             pass "$testname-$id"
 148         }
 149     } else {
 150         send_log "Output mismatch.\n"
 151         send_log "Expected: $outtext\n"
 152         send_log "Got     : $result\n"
 153         fail "$testname-$id"
 154     }
 155 }
 156
 157
 158 # Do a test in which we expect an input text file to be preserved unchanged.
 159 proc locate_roundtrip { id intext } {
 160     if ![regexp "\n$" $intext] {
 161         # We like the items to be terminated by newlines.
 162         error "The input text is not terminated by newline"
 163     }
 164
 165     locate_textonly p $id $intext "-r ." $intext
 166 }
 167
 168
 169
 170 # Run locate and leave the output in $comp_output.
 171 # Called by individual test scripts.
 172 proc locate_start { passfail updatedb_options locate_options
 173                     {updatedb_infile ""} {locate_infile ""}
 174                     { between_hook "" }
 175                 } {
 176     global verbose
 177     global LOCATE
 178     global LOCATEFLAGS
 179     global UPDATEDB
 180     global UPDATEDBFLAGS
 181     global comp_output
 182
 183     set fail_good [string match "f*" $passfail]
 184
 185     set scriptname [uplevel {info script}]
 186     set testbase [file rootname $scriptname]
 187     set testname [file tail $testbase]
 188
 189     set outfile "$testbase.xo"
 190     if {"$updatedb_infile" != ""} then {
 191         set updatedb_infile "[file dirname [file dirname $testbase]]/inputs/$updatedb_infile"
 192     } else {
 193         set updatedb_infile /dev/null
 194     }
 195     if {"$locate_infile" != ""} then {
 196         set locate_infile "[file dirname [file dirname $testbase]]/inputs/$locate_infile"
 197     } else {
 198         set locate_infile /dev/null
 199     }
 200
 201     catch "exec rm -f locate.out"
 202
 203     set updatedb_cmd "$UPDATEDB $UPDATEDBFLAGS $updatedb_options < $updatedb_infile"
 204     send_log "$updatedb_cmd\n"
 205     if $verbose>1 then {
 206         send_user "Spawning \"$updatedb_cmd\"\n"
 207     }
 208     catch "exec $updatedb_cmd" comp_output
 209
 210     if {$comp_output != ""} then {
 211         send_log "$comp_output\n"
 212         if $verbose>1 then {
 213             send_user "$comp_output\n"
 214         }
 215         # If fail_good is set, that refers to the exit
 216         # status of locate, not updatedb...
 217         fail "$testname: updatedb is supposed to be silent, $comp_output"
 218         return
 219     } else {
 220         send_log "updatedb: OK.\n"
 221     }
 222
 223
 224     eval $between_hook
 225
 226     set locate_cmd "$LOCATE $LOCATEFLAGS $locate_options < $locate_infile > locate.out"
 227     send_log "$locate_cmd\n"
 228     if $verbose>1 then {
 229         send_user "Spawning \"$locate_cmd\"\n"
 230     }
 231
 232     catch "exec $locate_cmd" comp_output
 233     if {$comp_output != ""} then {
 234         send_log "$comp_output\n"
 235         if $verbose>1 then {
 236             send_user "$comp_output\n"
 237         }
 238         if $fail_good then {
 239             pass "$testname"
 240         } else {
 241             fail "$testname: locate failed, $comp_output"
 242         }
 243         return
 244     }
 245
 246     if [file exists $outfile] then {
 247         set cmp_cmd "cmp locate.out $outfile"
 248         send_log "$cmp_cmd\n"
 249         catch "exec $cmp_cmd" cmpout
 250         if {$cmpout != ""} then {
 251             #catch "exec diff locate.out $outfile" diffout
 252             #puts $diffout
 253             fail "$testname, $cmpout"
 254             return
 255         }
 256     } else {
 257         if {[file size locate.out] != 0} then {
 258             fail "$testname, output should be empty"
 259             return
 260         }
 261     }
 262     pass "$testname"
 263     catch "exec rm -rf tmp"
 264 }
 265
 266
 267
 268 proc locate_from_db { passfail locate_options locate_database } {
 269     global LOCATE
 270     global LOCATEFLAGS
 271     global verbose
 272
 273     set fail_good [string match "f*" $passfail]
 274     set scriptname [uplevel {info script}]
 275     set testbase [file rootname $scriptname]
 276     set testname [file tail $testbase]
 277     set testdir  [file dirname $scriptname]
 278
 279     set dbpath "$testdir/$locate_database"
 280     set outfile "$testbase.xo"
 281
 282     set locate_cmd "$LOCATE $LOCATEFLAGS -d $dbpath $locate_options > locate.out"
 283     send_log "$locate_cmd\n"
 284     if $verbose>1 then {
 285         send_user "Spawning \"$locate_cmd\"\n"
 286     }
 287
 288     catch "exec $locate_cmd 2>/dev/null" comp_output
 289     if {$comp_output != ""} then {
 290         send_log "$comp_output\n"
 291         if $verbose>1 then {
 292             send_user "$comp_output\n"
 293         }
 294         if $fail_good then {
 295             # XXX: in general may want to compare output, too.
 296             pass "$testname"
 297         } else {
 298             fail "$testname: locate unfortunately failed, $comp_output"
 299         }
 300         return
 301     }
 302
 303
 304     if [file exists $outfile] then {
 305         set cmp_cmd "cmp locate.out $outfile"
 306         send_log "$cmp_cmd\n"
 307         catch "exec $cmp_cmd" cmpout
 308         if {$cmpout != ""} then {
 309             #catch "exec diff locate.out $outfile" diffout
 310             #puts $diffout
 311             fail "$testname, $cmpout"
 312             return
 313         }
 314     } else {
 315         if {[file size locate.out] != 0} then {
 316             fail "$testname, output should be empty"
 317             return
 318         }
 319     }
 320     pass "$testname"
 321 }
 322
 323
 324
 325
 326
 327 # Called by runtest.
 328 # Clean up (remove temporary files) before runtest exits.
 329 proc locate_exit {} {
 330     catch "exec rm -f locate.out updatedb-paths.txt locate.db"
 331 }
 332
 333 # Called by runtest.
 334 # Extract and print the version number of updatedb.
 335 proc updatedb_version {} {
 336     global UPDATEDB
 337     global UPDATEDBFLAGS
 338
 339     if {[which $UPDATEDB] != 0} then {
 340         set tmp [ eval exec $UPDATEDB $UPDATEDBFLAGS --version </dev/null ]
 341         regexp "version.*$" $tmp version
 342         if [info exists version] then {
 343             clone_output "[which $UPDATEDB] $version\n"
 344         } else {
 345             warning "cannot get version from $tmp."
 346         }
 347     } else {
 348         warning "$UPDATEDB, program does not exist"
 349     }
 350 }
 351