locate/testsuite/config/unix.exp

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