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 | sed 1q]
  92         clone_output $tmp
  93     } else {
  94         warning "$LOCATE, program does not exist"
  95     }
  96 }
  97
  98
  99 # Run locate and leave the output in $comp_output.
 100 # Called by individual test scripts.
 101 proc locate_textonly { passfail id intext locateoptions outtext } {
 102     global LOCATE
 103     global FRCODE
 104
 105     set fail_good [string match "f*" $passfail]
 106
 107     set scriptname [uplevel {info script}]
 108     set testbase [file rootname $scriptname]
 109     set testname [file tail $testbase]
 110     set listfile "updatedb-paths.txt"
 111     set dbfile   "locate.db"
 112     set outfile  "locate.out"
 113
 114     # Generate the "frcode" input.
 115     catch { file delete -force $listfle }
 116     set f [open $listfile w]
 117     puts $f "$intext"
 118     close $f
 119
 120     # Run frcode
 121     exec $FRCODE < $listfile > $dbfile
 122
 123     # Now run locate.
 124     set locatecmd "$LOCATE -d $dbfile $locateoptions"
 125     send_log "Running $locatecmd \n"
 126     catch "exec $locatecmd > $outfile"
 127
 128     set result ""
 129     set f [open "$outfile" r]
 130     while { [ gets $f line ]  >= 0 } {
 131         # send_log "Output fragment is $line\n"
 132         append result "$line\n"
 133     }
 134     close $f
 135
 136     # send_log "Output is $result\n"
 137
 138     if {[string equal $result $outtext]} {
 139         if $fail_good then {
 140             fail "$testname-$id"
 141         } else {
 142             pass "$testname-$id"
 143         }
 144     } else {
 145         send_log "Output mismatch.\n"
 146         send_log "Expected: $outtext\n"
 147         send_log "Got     : $result\n"
 148         fail "$testname-$id"
 149     }
 150 }
 151
 152
 153 # Do a test in which we expect an input text file to be preserved unchanged.
 154 proc locate_roundtrip { id intext } {
 155     if ![regexp "\n$" $intext] {
 156         # We like the items to be terminated by newlines.
 157         error "The input text is not terminated by newline"
 158     }
 159
 160     locate_textonly p $id $intext "-r ." $intext
 161 }
 162
 163
 164
 165 # Run locate and leave the output in $comp_output.
 166 # Called by individual test scripts.
 167 proc locate_start { passfail updatedb_options locate_options
 168                     {updatedb_infile ""} {locate_infile ""}
 169                     { between_hook "" }
 170                 } {
 171     global verbose
 172     global LOCATE
 173     global LOCATEFLAGS
 174     global UPDATEDB
 175     global UPDATEDBFLAGS
 176     global comp_output
 177
 178     set fail_good [string match "f*" $passfail]
 179
 180     set scriptname [uplevel {info script}]
 181     set testbase [file rootname $scriptname]
 182     set testname [file tail $testbase]
 183
 184     set outfile "$testbase.xo"
 185     if {"$updatedb_infile" != ""} then {
 186         set updatedb_infile "[file dirname [file dirname $testbase]]/inputs/$updatedb_infile"
 187     } else {
 188         set updatedb_infile /dev/null
 189     }
 190     if {"$locate_infile" != ""} then {
 191         set locate_infile "[file dirname [file dirname $testbase]]/inputs/$locate_infile"
 192     } else {
 193         set locate_infile /dev/null
 194     }
 195
 196     catch "exec rm -f locate.out"
 197
 198     set updatedb_cmd "$UPDATEDB $UPDATEDBFLAGS $updatedb_options < $updatedb_infile"
 199     send_log "$updatedb_cmd\n"
 200     if $verbose>1 then {
 201         send_user "Spawning \"$updatedb_cmd\"\n"
 202     }
 203     catch "exec $updatedb_cmd" comp_output
 204
 205     if {$comp_output != ""} then {
 206         send_log "$comp_output\n"
 207         if $verbose>1 then {
 208             send_user "$comp_output\n"
 209         }
 210         # If fail_good is set, that refers to the exit
 211         # status of locate, not updatedb...
 212         fail "$testname: updatedb is supposed to be silent, $comp_output"
 213         return
 214     } else {
 215         send_log "updatedb: OK.\n"
 216     }
 217
 218
 219     eval $between_hook
 220
 221     set locate_cmd "$LOCATE $LOCATEFLAGS $locate_options < $locate_infile > locate.out"
 222     send_log "$locate_cmd\n"
 223     if $verbose>1 then {
 224         send_user "Spawning \"$locate_cmd\"\n"
 225     }
 226
 227     catch "exec $locate_cmd" comp_output
 228     if {$comp_output != ""} then {
 229         send_log "$comp_output\n"
 230         if $verbose>1 then {
 231             send_user "$comp_output\n"
 232         }
 233         if $fail_good then {
 234             pass "$testname"
 235         } else {
 236             fail "$testname: locate failed, $comp_output"
 237         }
 238         return
 239     }
 240
 241     if [file exists $outfile] then {
 242         set cmp_cmd "cmp locate.out $outfile"
 243         send_log "$cmp_cmd\n"
 244         catch "exec $cmp_cmd" cmpout
 245         if {$cmpout != ""} then {
 246             #catch "exec diff locate.out $outfile" diffout
 247             #puts $diffout
 248             fail "$testname, $cmpout"
 249             return
 250         }
 251     } else {
 252         if {[file size locate.out] != 0} then {
 253             fail "$testname, output should be empty"
 254             return
 255         }
 256     }
 257     pass "$testname"
 258     catch "exec rm -rf tmp"
 259 }
 260
 261
 262
 263 proc locate_from_db { passfail locate_options locate_database } {
 264     global LOCATE
 265     global LOCATEFLAGS
 266     global verbose
 267
 268     set fail_good [string match "f*" $passfail]
 269     set scriptname [uplevel {info script}]
 270     set testbase [file rootname $scriptname]
 271     set testname [file tail $testbase]
 272     set testdir  [file dirname $scriptname]
 273
 274     set dbpath "$testdir/$locate_database"
 275     set outfile "$testbase.xo"
 276
 277     set locate_cmd "$LOCATE $LOCATEFLAGS -d $dbpath $locate_options > locate.out"
 278     send_log "$locate_cmd\n"
 279     if $verbose>1 then {
 280         send_user "Spawning \"$locate_cmd\"\n"
 281     }
 282
 283     catch "exec $locate_cmd 2>/dev/null" comp_output
 284     if {$comp_output != ""} then {
 285         send_log "$comp_output\n"
 286         if $verbose>1 then {
 287             send_user "$comp_output\n"
 288         }
 289         if $fail_good then {
 290             # XXX: in general may want to compare output, too.
 291             pass "$testname"
 292         } else {
 293             fail "$testname: locate unfortunately failed, $comp_output"
 294         }
 295         return
 296     }
 297
 298
 299     if [file exists $outfile] then {
 300         set cmp_cmd "cmp locate.out $outfile"
 301         send_log "$cmp_cmd\n"
 302         catch "exec $cmp_cmd" cmpout
 303         if {$cmpout != ""} then {
 304             #catch "exec diff locate.out $outfile" diffout
 305             #puts $diffout
 306             fail "$testname, $cmpout"
 307             return
 308         }
 309     } else {
 310         if {[file size locate.out] != 0} then {
 311             fail "$testname, output should be empty"
 312             return
 313         }
 314     }
 315     pass "$testname"
 316 }
 317
 318
 319
 320
 321
 322 # Called by runtest.
 323 # Clean up (remove temporary files) before runtest exits.
 324 proc locate_exit {} {
 325     catch "exec rm -f locate.out updatedb-paths.txt locate.db"
 326 }
 327
 328 # Called by runtest.
 329 # Extract and print the version number of updatedb.
 330 proc updatedb_version {} {
 331     global UPDATEDB
 332     global UPDATEDBFLAGS
 333
 334     if {[which $UPDATEDB] != 0} then {
 335         set tmp [eval exec $UPDATEDB $UPDATEDBFLAGS --version </dev/null|sed 1q]
 336         clone_output $tmp
 337     } else {
 338         warning "$UPDATEDB, program does not exist"
 339     }
 340 }
 341