locate/testsuite/config/unix.exp

   1 # -*- TCL -*-
   2 # Test-specific TCL procedures required by DejaGNU.
   3 # Copyright (C) 1994 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 # look for UPDATEDB
  52 if ![info exists UPDATEDB] {
  53     set UPDATEDB [findfile $base_dir/../updatedb $base_dir/../updatedb [transform updatedb]]
  54     verbose "UPDATEDB defaulting to $UPDATEDB" 2
  55 }
  56
  57 global FRCODE
  58 # look for FRCODE
  59 if ![info exists FRCODE] {
  60     set FRCODE [findfile $base_dir/../frcode $base_dir/../frcode [transform frcode]]
  61     verbose "FRCODE defaulting to $FRCODE" 2
  62 }
  63
  64 global UPDATEDBFLAGS
  65 if ![info exists UPDATEDBFLAGS] then {
  66     set UPDATEDBFLAGS ""
  67 }
  68
  69 global LOCATE
  70 # look for LOCATE
  71 if ![info exists LOCATE] {
  72     set LOCATE [findfile $base_dir/../locate $base_dir/../locate [transform locate]]
  73     verbose "LOCATE defaulting to $LOCATE" 2
  74 }
  75
  76 global FIND
  77 # look for find
  78 if ![info exists FIND] {
  79     set FIND [findfile $base_dir/../../find/find $base_dir/../../find/find [transform find]]
  80     verbose "FIND defaulting to $FIND" 2
  81 }
  82 set env(find) "$FIND"
  83
  84 global LOCATEFLAGS
  85 if ![info exists LOCATEFLAGS] then {
  86     set LOCATEFLAGS ""
  87 }
  88
  89 # Called by runtest.
  90 # Extract and print the version number of locate.
  91 proc locate_version {} {
  92     global UPDATEDB
  93     global UPDATEDBFLAGS
  94     global LOCATE
  95     global LOCATEFLAGS
  96
  97     if {[which $LOCATE] != 0} then {
  98         set tmp [ eval exec $LOCATE $LOCATEFLAGS --version </dev/null ]
  99         regexp "version.*$" $tmp version
 100         if [info exists version] then {
 101             clone_output "[which $LOCATE] $version\n"
 102         } else {
 103             warning "cannot get version from $tmp."
 104         }
 105     } else {
 106         warning "$LOCATE, program does not exist"
 107     }
 108 }
 109
 110 # Run locate and leave the output in $comp_output.
 111 # Called by individual test scripts.
 112 proc locate_textonly { passfail id intext locateoptions outtext } {
 113     global LOCATE
 114     global FRCODE
 115
 116     if {[which $LOCATE] == 0} then {
 117         error "$LOCATE, program does not exist"
 118         exit 1
 119     }
 120
 121     if {[which $FRCODE] == 0} then {
 122         error "$FRCODE, program does not exist"
 123         exit 1
 124     }
 125
 126     set fail_good [string match "f*" $passfail]
 127
 128     set scriptname [uplevel {info script}]
 129     set testbase [file rootname $scriptname]
 130     set testname [file tail $testbase]
 131     set listfile "updatedb-paths.txt"
 132     set dbfile   "locate.db"
 133     set outfile  "locate.out"
 134
 135     # Generate the "frcode" input.
 136     catch { file delete -force $listfle }
 137     set f [open $listfile w]
 138     puts $f "$intext"
 139     close $f
 140
 141     # Run frcode
 142     exec $FRCODE < $listfile > $dbfile
 143
 144     # Now run locate.
 145     set locatecmd "$LOCATE -d $dbfile $locateoptions"
 146     send_log "Running $locatecmd \n"
 147     catch "exec $locatecmd > $outfile"
 148
 149     set result ""
 150     set f [open "$outfile" r]
 151     while { [ gets $f line ]  >= 0 } {
 152         # send_log "Output fragment is $line\n"
 153         append result "$line\n"
 154     }
 155     close $f
 156
 157     # send_log "Output is $result\n"
 158
 159     if {[string equal $result $outtext]} {
 160         if $fail_good then {
 161             fail "$testname-$id"
 162         } else {
 163             pass "$testname-$id"
 164         }
 165     } else {
 166         send_log "Output mismatch.\n"
 167         send_log "Expected: $outtext\n"
 168         send_log "Got     : $result\n"
 169         fail "$testname-$id"
 170     }
 171 }
 172
 173
 174 # Do a test in which we expect an input text file to be preserved unchanged.
 175 proc locate_roundtrip { id intext } {
 176     if ![regexp "\n$" $intext] {
 177         # We like the items to be terminated by newlines.
 178         error "The input text is not terminated by newline"
 179     }
 180
 181     locate_textonly p $id $intext "-r ." $intext
 182 }
 183
 184
 185
 186 # Run locate and leave the output in $comp_output.
 187 # Called by individual test scripts.
 188 proc locate_start { passfail updatedb_options locate_options
 189                     {updatedb_infile ""} {locate_infile ""}
 190                     { between_hook "" }
 191                 } {
 192     global verbose
 193     global LOCATE
 194     global LOCATEFLAGS
 195     global UPDATEDB
 196     global UPDATEDBFLAGS
 197     global comp_output
 198
 199     if {[which $UPDATEDB] == 0} then {
 200         error "$UPDATEDB, program does not exist"
 201         exit 1
 202     }
 203     if {[which $LOCATE] == 0} then {
 204         error "$LOCATE, program does not exist"
 205         exit 1
 206     }
 207
 208     set fail_good [string match "f*" $passfail]
 209
 210     set scriptname [uplevel {info script}]
 211     set testbase [file rootname $scriptname]
 212     set testname [file tail $testbase]
 213
 214     set outfile "$testbase.xo"
 215     if {"$updatedb_infile" != ""} then {
 216         set updatedb_infile "[file dirname [file dirname $testbase]]/inputs/$updatedb_infile"
 217     } else {
 218         set updatedb_infile /dev/null
 219     }
 220     if {"$locate_infile" != ""} then {
 221         set locate_infile "[file dirname [file dirname $testbase]]/inputs/$locate_infile"
 222     } else {
 223         set locate_infile /dev/null
 224     }
 225
 226     catch "exec rm -f locate.out"
 227
 228     set updatedb_cmd "$UPDATEDB $UPDATEDBFLAGS $updatedb_options < $updatedb_infile"
 229     send_log "$updatedb_cmd\n"
 230     if $verbose>1 then {
 231         send_user "Spawning \"$updatedb_cmd\"\n"
 232     }
 233     catch "exec $updatedb_cmd" comp_output
 234
 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 is set, that refers to the exit status of locate, not updatedb...
 241         fail "$testname, $comp_output"
 242         return
 243     } else {
 244         send_log "updatedb: OK.\n"
 245     }
 246
 247
 248     eval $between_hook
 249
 250     set locate_cmd "$LOCATE $LOCATEFLAGS $locate_options < $locate_infile > locate.out"
 251     send_log "$locate_cmd\n"
 252     if $verbose>1 then {
 253         send_user "Spawning \"$locate_cmd\"\n"
 254     }
 255
 256     catch "exec $locate_cmd" comp_output
 257     if {$comp_output != ""} then {
 258         send_log "$comp_output\n"
 259         if $verbose>1 then {
 260             send_user "$comp_output\n"
 261         }
 262         if $fail_good then {
 263             pass "$testname"
 264         } else {
 265             fail "$testname, $comp_output"
 266         }
 267         return
 268     }
 269
 270     if [file exists $outfile] then {
 271         set cmp_cmd "cmp locate.out $outfile"
 272         send_log "$cmp_cmd\n"
 273         catch "exec $cmp_cmd" cmpout
 274         if {$cmpout != ""} then {
 275             #catch "exec diff locate.out $outfile" diffout
 276             #puts $diffout
 277             fail "$testname, $cmpout"
 278             return
 279         }
 280     } else {
 281         if {[file size locate.out] != 0} then {
 282             fail "$testname, output should be empty"
 283             return
 284         }
 285     }
 286     pass "$testname"
 287     catch "exec rm -rf tmp"
 288 }
 289
 290 # Called by runtest.
 291 # Clean up (remove temporary files) before runtest exits.
 292 proc locate_exit {} {
 293     catch "exec rm -f locate.out updatedb-paths.txt locate.db"
 294 }
 295
 296 # Called by runtest.
 297 # Extract and print the version number of updatedb.
 298 proc updatedb_version {} {
 299     global UPDATEDB
 300     global UPDATEDBFLAGS
 301
 302     if {[which $UPDATEDB] != 0} then {
 303         set tmp [ eval exec $UPDATEDB $UPDATEDBFLAGS --version </dev/null ]
 304         regexp "version.*$" $tmp version
 305         if [info exists version] then {
 306             clone_output "[which $UPDATEDB] $version\n"
 307         } else {
 308             warning "cannot get version from $tmp."
 309         }
 310     } else {
 311         warning "$UPDATEDB, program does not exist"
 312     }
 313 }
 314