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