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